home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pct500.arc / PCT500.BAS < prev    next >
BASIC Source File  |  1986-03-29  |  66KB  |  1,166 lines
  1. 1  ' $TITLE: 'Revised PC-TALK 3, Ver 3.65, Level 840517, 5/17/84' $SUBTITLE:  'Compile /O/E/S/C:4096.LINK:.OBJ's IBMCOM+CHDIR+GETDIR+DSK' if you optimize the basic pgm, use /N & omit /S)
  2. 2  ' by Jim Gainsley, Mpls MN 55401 (612)338-6124 (CompuServe 70346,457), which      besides the work of the author, incorporates the work of John Chapmen,          Wes Meier, & Jack Wright, & one unknown author.  (See .DOC) -- 5/17/84
  3. 3  ' WARNING! DO NOT USE THIS PROGRAM: 1) IF YOU DO NOT HAVE THE BASIC COMPILER      2) UNTIL YOU HAVE READ PCT365.DOC.  3) UNTIL YOU HAVE OBTAINED THE .OBJ         FILES MENTIONED ABOVE (IBMCOM IS A PART OF THE COMPILER PACKAGE). 4) IF
  4. 4  ' YOUR MEMORY IS NOT AT LEAST 128K.
  5. 5  ' THIS VERSION INCLUDES CHANGES MADE BY GENE PLANTZ  IN  MARCH, 1984
  6. 6  ' This version includes ALT-B "Silent Mode" and fixes by Bob Mahoney, August, 1984
  7. 7  ' The Headlands Press, Inc.
  8. 8  ' P.O. Box 862
  9. 9  ' Tiburon, CA 94920
  10. 10 ' ******************************  NOTICE  *********************************
  11. 30 '
  12. 45 '
  13. 50 SCREEN 0,1,0:WIDTH 80:CLS:KEY OFF:LOCATE ,,0
  14. 52 PRINT TAB(28)"tm":PRINT TAB(8);STRING$(4,205)" F R E E W A R E ";               STRING$(4,205)
  15. 54 PRINT TAB(9)"User-Supported Software":PRINT:PRINT CHR$(214)STRING$(36,196);     CHR$(183)
  16. 56 FOR I=1 TO 17:READ A$:PRINT CHR$(186);A$;SPACE$(36-LEN(A$));CHR$(186):NEXT
  17. 58 PRINT CHR$(211)STRING$(36,196)CHR$(189):PRINT"Copyright 1983, The Headlands Press, Inc.";:LOCATE 1,1
  18. 60 DATA"   If you use this program and find
  19. 62 DATA"   it of value, your contribution
  20. 64 DATA"   ($35.00 suggested) would be
  21. 66 DATA"   appreciated . . .
  22. 68 DATA"
  23. 70 DATA"         === Freeware ===
  24. 72 DATA"           P.O. Box 682
  25. 74 DATA"         Tiburon, CA 94920
  26. 76 DATA"
  27. 78 DATA"   You are encouraged to copy and
  28. 80 DATA"   share this program with other
  29. 82 DATA"   users, on the conditions that
  30. 84 DATA"   the program is not distributed
  31. 86 DATA"   in modified form, that no fee
  32. 88 DATA"   or consideration is charged,
  33. 90 DATA"   and that this notice is not
  34. 92 DATA"   bypassed or removed.
  35. 99 '
  36. 100 '   *****  INITIALIZE VARIABLES  *****
  37. 105 SILENT=-1
  38. 110 CLOSE:DEFINT A-Z:OPTION BASE 1:ON ERROR GOTO 9000
  39. 115 I=0:P=0:A$="":RC=0:PR=0:LF$="":BS$="":NS=0:DIM S$(3):DIM R$(3):SET=0:PSE=0:XF$="":XN$="":HLT=0:X$="":Y$="":Z$="":B$="":C$="":J=0
  40. 116 SP=0:CLIN$=STRING$(79,32)
  41. 117 IB=0
  42. 120 FLN!=0:CNT!=0:SD=32767
  43. 125 DIM ALT$(10):DIM K$(40)
  44. 130 FOR I=1 TO 10:KEY I,"":NEXT
  45. 135 BS$=CHR$(8):LF$=CHR$(10):CR$=CHR$(13)
  46. 140 RCV$="":TRN$="":DIAL$="":STRT$="--":GO$="===Proceed ...
  47. 145 DIM KPG$(4):KPG$(1)="Func":KPG$(2)=" Alt":KPG$(3)="Shft":KPG$(4)="Ctrl
  48. 150 DIM DS$(3):DIM DR$(3)
  49. 155 VL$=CHR$(179):EF$=CHR$(26):BL$=CHR$(7):ENT$=CHR$(17)+CHR$(196)+CHR$(217)
  50. 160 XN$=CHR$(17):XF$=CHR$(19):SOH$=CHR$(1):EOT$=CHR$(4):ACK$=CHR$(6):NAK$=CHR$(21):CAN$=CHR$(24)
  51. 165 DFIL$="pc-talk.dir":KFIL$="pc-talk.key":FFIL$="pc-talk.def":IFIL$="INITIALIII"
  52. 199 '
  53. 200 '   *****  GET DEFAULTS  *****
  54. 201 '
  55. 210 DFNUM=29:DIM DP$(29):DIM D$(29):DIM DT$(29)
  56. 215 CLOSE#1:OPEN FFIL$ FOR INPUT AS #1
  57. 220 INPUT#1,Q$:IF Q$<>IFIL$ THEN 245
  58. 225 FOR I=1 TO DFNUM:INPUT#1,DP$(I),D$(I):NEXT
  59. 230 '
  60. 235 INPUT#1,Q$:IF Q$<>IFIL$ THEN 245
  61. 240 GOSUB 5600:GOTO 300
  62. 245 GOSUB 50500:PRINT"*** Re-initializing Default File ***":CLOSE#1:KILL FFIL$:GOTO 5400
  63. 250 '
  64. 300 '   *****  START-UP  *****
  65. 305 '
  66. 310 '
  67. 315 '
  68. 316 BGI=BG:FGI=FG:IFLAG=0:BFLAG=0:ESC=0:C$=""
  69. 320 COLOR FG,BG,BG:CLS:LOCATE 1,39:COLOR BG,FG:PRINT SPACE$(5);                         "MAKE SURE THAT YOUR MODEM IS ON"SPACE$(4):COLOR FG,BG:PRINT:RESTORE 355
  70. 325 LOCATE 3,39:PRINT CHR$(213);STRING$(38,205);CHR$(184)
  71. 330 FOR I=1 TO 6:READ A$:LOCATE ,39:PRINT VL$;A$;SPACE$(38-LEN(A$));VL$:NEXT
  72. 335 LOCATE ,39:PRINT VL$;STRING$(38,196);VL$
  73. 340 FOR I=1 TO 12:READ A$:LOCATE ,39:PRINT VL$;A$;SPACE$(38-LEN(A$));VL$:NEXT
  74. 345 LOCATE ,39:PRINT CHR$(212);STRING$(38,205);CHR$(190);
  75. 350 '
  76. 355 DATA"     =====    PC-TALK III    =====
  77. 357 DATA"         Revised  August, 1984
  78. 360 DATA"          COLOR/MUSIC/WINDOWS
  79. 361 DATA"      Version  5.00   For DOS 2.x
  80. 365 DATA"       Communications Program for
  81. 370 DATA"       The IBM Personal Computer
  82. 373 DATA"
  83. 380 DATA" PRESS: <Home>: For Command Summary
  84. 385 DATA"       <Alt-E>: If you cannot see
  85. 390 DATA"                your keyboard input
  86. 391 DATA"   <Ctrl-Home>: For Split - Screen
  87. 392 DATA"                Operation (Toggle)
  88. 393 DATA"                <Esc> to clear
  89. 394 DATA"                <cr sub> for multiple
  90. 395 DATA"       <Alt>-O: For I.B.M. 3101
  91. 396 DATA"       <Alt>-B: For Silent Mode
  92. 398 DATA"
  93. 399 DATA"   (c)1983 The Headlands Press,Inc.
  94. 400 '
  95. 405 CLOSE#2:OPEN KFIL$ AS #2:FIELD #2,126 AS K$,2 AS L$
  96. 410 GET#2,1:IF LEFT$(K$,LEN(IFIL$))<>IFIL$ THEN GOSUB 7425
  97. 415 FOR I=1 TO 40:GET#2,I+1:LN=CVI(L$):IF LN=0 THEN 420 ELSE K$(I)=LEFT$(K$,LN)
  98. 420 NEXT:CLOSE #2
  99. 423 B$=SPACE$(38):LOCATE 1,1:FOR I=1 TO 24:IF I=24 THEN PRINT B$; ELSE        PRINT B$:NEXT  'Erases logo section
  100. 425 CLOSE#1:OPEN COMM$ AS #1:PRINT #1,MODMINIT$  ' ';' removed. Must hve cr
  101. 426 '  if init commands are of the 'ATxx' variety.
  102. 430 ROW=1:COL=1:GOSUB 2820:LOCATE 1,1,1:PRINT GO$
  103. 435 '
  104. 500 '  *********  M A I N   I N P U T / O U T P U T  ***********
  105. 505 '
  106. 510 '  -- Keyboard
  107. 515 IF TR THEN IF TR$="X" THEN 4860 ELSE 4060
  108. 517 IF TMP$="" AND SP THEN XPOS=1
  109. 520 B$=INKEY$:IF B$="" THEN 560
  110. 525 IF LEN(B$)>1 THEN 1500
  111. 526 '
  112. 527 'NOTE: Added "AND NOT SP" to 530 so that split screen back space worked ok       if echo was also on  -Dennis Cheves- (904) 376-0718
  113. 530 IF B$=BS$ THEN CCNT=CCNT-1:IF ECH AND NOT SP THEN GOSUB 2655:IF PR THEN PR$=PR$+B$:GOSUB 800:GOTO 555 ELSE 555 ELSE 555
  114. 535 IF MARG<=0 THEN 550
  115. 540 IF INSTR(B$,CR$)<>0 THEN CCNT=0:GOTO 550
  116. 545 CCNT=CCNT+LEN(B$):IF CCNT>=MARG AND CCNT<MARG+10 THEN GOSUB 50500
  117. 550 IF ECH THEN PRINT B$;:IF PR THEN PR$=PR$+B$:GOSUB 800
  118. 555 IF SP THEN 11000
  119. 557 IF IB AND B$=CHR$(27) THEN B$=B$+CHR$(76)
  120. 558 PRINT#1,B$;
  121. 560 IF EOF(1) THEN 515 ELSE 605
  122. 600 '  -- Comm Port
  123. 605 IF LOF(1)<128 THEN PSE=-1:PRINT#1,XF$;
  124. 610 IF EOF(1) THEN 710
  125. 612 IF SP THEN LOCATE ROW,COL,0
  126. 615 A$=INPUT$(LOC(1),#1):IF NS=0 THEN 635
  127. 616 IF SILENT THEN P=INSTR(A$,CHR$(7)):IF P=0 THEN 620 ELSE A$=LEFT$(A$,P-1)+R$(I)+RIGHT$(A$,LEN(A$)-P)
  128. 620 FOR I=1 TO NS
  129. 625 P=INSTR(A$,S$(I)):IF P=0 THEN 628 ELSE A$=LEFT$(A$,P-1)+R$(I)+RIGHT$(A$,LEN(A$)-P):GOTO 625
  130. 628 P=INSTR(A$,CHR$(0)):IF P=0 THEN 630 ELSE A$=LEFT$(A$,P-1)+RIGHT$(A$,LEN(A$)-P):GOTO 625
  131. 630 NEXT
  132. 635 IF RC THEN PRINT#2,A$;
  133. 636 IF IB THEN 13010
  134. 637 X = LEN(A$):P=INSTR(A$,LF$):IF P=0 THEN 638 ELSE A$=LEFT$(A$,P-1)+RIGHT$(A$,X-P):GOTO 637
  135. 638 FOR I = 1 TO X:Z$=MID$(A$,I,1)
  136. 639 IF (Z$=CHR$(127)) THEN 655
  137. 640 IF ASC(Z$) = 27 THEN ESC=1
  138. 641 IF Z$=BS$ THEN GOSUB 2650:GOTO 655
  139. 642 IF SILENT AND ASC(Z$)=7 THEN GOTO 655
  140. 645 IF ESC=1 THEN C$=C$+Z$ ELSE GOTO 650
  141. 646 FF = INSTR("fmJ"+CHR$(14)+CHR$(93)+CHR$(124)+CHR$(91),Z$)
  142. 647 IF FF=0 THEN GOTO 655 ELSE GOSUB 12000:ESC=0:C$="":GOTO 655
  143. 650 PRINT Z$;
  144. 655 NEXT I
  145. 660 IF SP THEN ROW=CSRLIN:COL=POS(0):LOCATE 25,XPOS,1
  146. 661 IF PR THEN PR$=PR$+A$:GOSUB 800
  147. 700 '  -- Check Status
  148. 705 IF SET THEN 715
  149. 710 B$=INKEY$:IF B$<>"" THEN 525
  150. 715 IF LOC(1)>0 THEN 605
  151. 720 IF PSE THEN PSE=0:PRINT#1,XN$;
  152. 725 IF SET THEN ROW=CSRLIN:COL=POS(0):GOTO 1000
  153. 730 GOTO 515
  154. 800 '  -- Printer buffer
  155. 805 P=INSTR(PR$,BS$):IF P=0 THEN 810 ELSE IF LEN(PR$)>1 THEN PR$=LEFT$(PR$,P-2)+RIGHT$(PR$,LEN(PR$)-P):GOTO 805
  156. 810 P=INSTR(PR$,CR$):IF P=0 THEN 815 ELSE PRINT#3,LEFT$(PR$,P);:PR$=RIGHT$(PR$,LEN(PR$)-P):GOTO 810
  157. 815 IF LEN(PR$)>220 THEN PRINT#3,PR$;:PR$="":RETURN
  158. 820 RETURN
  159. 825 '
  160. 1000 '   *****  ALT-KEY INPUT  *****
  161. 1005 '
  162. 1010 IF ALTSET THEN LOCATE 25,17 ELSE LOCATE 25,15+LEN(ALT$)
  163. 1015 C$=INKEY$:IF C$="" THEN IF EOF(1) THEN 1015 ELSE SET=-1:LOCATE ROW,COL:GOTO 605
  164. 1020 IF NOT ALTSET THEN 1035
  165. 1025 LOCATE 25,19:IF ASC(C$)>=49 AND ASC(C$)<=57 THEN ALTKY=ASC(C$)-48ELSE IF ASC(C$)=48 THEN ALTKY=10 ELSE GOSUB 50500:GOTO 1010
  166. 1030 IF ALTSET THEN ALTSET=0:SET=-1:LOCATE 25,1:PRINT STRING$(5,16);" Alt-";ALTKY;CHR$(198);"    ";CHR$(181);:GOTO 1010
  167. 1035 IF LEN(ALT$)>=51 THEN ALT$=LEFT$(ALT$,49):LOCATE 25,64:PRINT" ";CHR$(181);:LOCATE 25,66:GOSUB 50500:PRINT"(max 50 chrs.)";:GOTO 1010
  168. 1040 IF C$=BS$ THEN IF ALT$="" GOTO 1010 ELSE GOSUB 2650:ALT$=LEFT$(ALT$,LEN(ALT$)-1):GOTO 1010
  169. 1045 IF C$=CHR$(13) THEN 1070
  170. 1050 IF C$>CHR$(31) THEN PRINT C$; ELSE COLOR HI,BG:PRINT CHR$(ASC(C$)+64);:COLOR FG,BG
  171. 1055 PRINT"    ";CHR$(181);
  172. 1060 IF C$=XCR$ THEN C$=CHR$(13)
  173. 1065 ALT$=ALT$+C$:GOTO 1010
  174. 1070 IF ALT$<>"" THEN IF ALT$=" " THEN ALT$(ALTKY)="" ELSE ALT$(ALTKY)=ALT$
  175. 1075 ALT$="":SET=0:GOTO 1200
  176. 1080 '
  177. 1200 '   *****  ALT-KEY DISPLAY  *****
  178. 1205 '
  179. 1210 P=1:FOR I=1 TO 10:LOCATE 25,P:IF I=10 THEN PRINT"0";:COLOR BG,FG:GOTO 1220
  180. 1215 PRINT USING "#";I;:COLOR BG,FG
  181. 1220 FOR J=1 TO 7:Z$=MID$(ALT$(I),J,1):IF POS(0)=80 THEN 1235
  182. 1225 IF J>LEN(ALT$(I)) THEN PRINT" ";:GOTO 1235
  183. 1230 IF Z$>=" "THEN PRINT Z$; ELSE IF Z$=CR$ THEN PRINT XCR$; ELSE COLOR HI,FG:PRINT CHR$(ASC(Z$)+64);:COLOR BG,FG
  184. 1235 NEXT J:COLOR FG,BG:P=P+8:NEXT I
  185. 1240 FOR I=1 TO 10:IF ALT$(I)<>"" THEN EXIT=-1
  186. 1245 NEXT:IF EXIT THEN EXIT=0:LOCATE ROW,COL:GOTO 605
  187. 1250 LOCATE ROW,COL:GOSUB 2820:GOTO 515
  188. 1255 '
  189. 1500 '  **********  E X T E N D E D   C O D E S  **********
  190. 1505 '
  191. 1510 EX=0:ROW=CSRLIN:COL=POS(0)
  192. 1515 IF LEN(B$)=2 THEN EX=ASC(MID$(B$,2,1)) ELSE EX=0
  193. 1516 IF NOT IB THEN 1530
  194. 1517 '
  195. 1518 IF EX=71 THEN B$=CHR$(127):GOTO 535
  196. 1519 IF EX=72 THEN B$=CHR$(27)+CHR$(65):GOTO 535
  197. 1520 IF EX=73 THEN B$=CHR$(27)+CHR$(75):GOTO 535
  198. 1521 IF EX=75 THEN B$=CHR$(27)+CHR$(68):GOTO 535
  199. 1522 IF EX=77 THEN B$=CHR$(27)+CHR$(67):GOTO 535
  200. 1523 IF EX=79 THEN B$=CHR$(27)+CHR$(73):GOTO 535
  201. 1524 IF EX=80 THEN B$=CHR$(27)+CHR$(66):GOTO 535
  202. 1525 IF EX=81 THEN B$=CHR$(23):GOTO 535
  203. 1526 IF EX=82 THEN B$=CHR$(22):GOTO 535
  204. 1527 IF EX=83 THEN B$=CHR$(127):GOTO 535
  205. 1528 IF EX=15 THEN B$=CHR$(7):GOTO 535
  206. 1530 IF EX=75 THEN B$=CHR$(29):GOTO 535
  207. 1531 IF EX=35 THEN 1850
  208. 1532 IF EX=77 THEN B$=CHR$(28):GOTO 535
  209. 1533 IF EX=71 THEN 2000
  210. 1535 IF EX=19 OR EX=81 THEN EX=19:GOTO 3000
  211. 1540 IF EX=47 THEN 3400
  212. 1545 IF EX=20 OR EX=73 THEN EX=20:GOTO 3200
  213. 1549 '  -- Parms/Dialing/Function key setting
  214. 1550 IF EX=25 THEN 5000
  215. 1555 IF EX=32 THEN 6000
  216. 1560 IF EX=36 OR EX=37 THEN 7000
  217. 1565 '  -- Function-Keys/Alt-Keys
  218. 1570 IF EX>=59 AND EX<=68 THEN B$=K$(EX-58):GOTO 535
  219. 1575 IF EX>=104 AND EX<=113 THEN B$=K$(EX-93):GOTO 535
  220. 1580 IF EX>=84 AND EX<=103 THEN B$=K$(EX-63):GOTO 535
  221. 1585 IF EX>=120 AND EX<=129 THEN B$=ALT$(EX-119):GOTO 535
  222. 1590 IF EX=15 THEN:GOSUB 50500:LOCATE 25,1:PRINT"  set Alt-(1-0):  ";CHR$(181);:ALTSET=     -1:GOTO 1000  'Shft-TB Used in place of 131. Prokey uses Alt-=  Shft-Tab        was used to read level #, now a part of Start-up Screen -- Jim Gainsley
  223. 1595 '  -- Echo/Message/Print
  224. 1600 IF EX=18 THEN GOSUB 50500:PRINT:IF ECH=0 THEN ECH=-1:PRINT"===ECHO ON===":GOTO 515 ELSE ECH=0:PRINT"===ECHO OFF===":GOTO 515
  225. 1605 IF EX=50 THEN GOSUB 50500:PRINT:IF MSG=0 THEN MSG=-1:PRINT"===MESSAGES ON===":GOTO 515 ELSE MSG=0:PRINT"===MESSAGES OFF===":GOTO 515
  226. 1610 IF EX=114 OR EX=132 THEN GOSUB 50500:PRINT:IF PR=0 THEN PR=-1:PRINT"===PRINTOUT ON===":CLOSE#3:OPEN PRNTPORT$ AS #3:PRINT#3,PRNTINIT$;:GOTO 515 ELSE PR=0:CLOSE#3:PRINT"===PRINTOUT OFF===":GOSUB 2715:GOTO 515
  227. 1615 '  -- Elapsed time/Redial/Screendump/Defaults/Exit
  228. 1620 IF EX=44 THEN 8200
  229. 1625 IF EX=16 THEN IF DIAL$<>"" THEN 8000 ELSE GOSUB 50500:PRINT"(nothing to redial)":PRINT GO$:GOTO 515
  230. 1630 IF EX=31 THEN 3800
  231. 1635 IF EX=33 THEN 5200
  232. 1640 IF EX=45 THEN GOSUB 50500:CLS:PRINT"===EXIT TO DOS===":PRINT:PRINT"WARNING!  If you proceed you will terminate the program.":PRINT"Do you want to do this (y/n)?";
  233. 1642 IF EX=45 THEN Q$=INPUT$(1):GOSUB 2555:IF Q$="N" THEN PRINT:PRINT GO$:GOTO 515 ELSE IF Q$="Y" THEN 8915 ELSE 1640
  234. 1645 '  -- Logged drive/Delete/Clearscreen/Width alarm/Menu/Break
  235. 1650 IF EX=38 THEN GOSUB 50500:PRINT:PRINT"===SPECIFY LOGGED DRIVE===":PRINT"Current default for file specs: ";DRIV$:PRINT"New default: ";:QL=2:GOSUB 2500:IF Q$="" THEN PRINT:PRINT GO$:GOTO 515 ELSE DRIV$=LEFT$(Q$,1)+":":PRINT:PRINT GO$:GOTO 515
  236. 1655 IF EX=21 THEN 3900
  237. 1660 IF EX=46 THEN PRINT CHR$(12):GOSUB 2800:GOTO 515
  238. 1665 IF EX=17 THEN GOSUB 50500:PRINT"===SPECIFY WIDTH ALARM===":PRINT"Current setting for right margin:";MARG:PRINT"New setting: ";:QL=3:GOSUB 2500:IF Q$="" THEN PRINT:PRINT GO$:GOTO 515 ELSE MARG=VAL(Q$):PRINT:PRINT GO$:GOTO 515
  239. 1670 IF EX=117 THEN OLDVAL=INP(LCR):BRKVAL=OLDVAL OR 64:OUT LCR,BRKVAL:SOUND SD,3:SOUND SD,1:OUT LCR,OLDVAL:GOTO 515
  240. 1675 '  (Shft-Tab (EX=15) now used for Alt-1/0 Temp Keys)
  241. 1680 '
  242. 1681 '  -- More Extended Codes can go here (see p.G-6 IBM BASIC manual)
  243. 1682 IF EX=119 THEN 10000
  244. 1685 '
  245. 1690 '
  246. 1691 '  -- CHDIR/Insert Alt-1-0/Save Alt-1-0/ALT COMM PORT/Keyboard pacing
  247. 1692 IF EX=34 THEN GOTO 11100
  248. 1693 IF EX=23 THEN GOTO 11130
  249. 1694 IF EX=22 THEN GOTO 11160
  250. 1695 IF EX=30 THEN GOTO 515 'Not implemented
  251. 1696 IF EX=24 THEN GOTO 13000 'I.B.M. 3101 Operation
  252. 1697 IF EX=48 THEN GOTO 60000 'Silent mode toggle
  253. 1699 GOTO 515 'DON'T remove this line! (failsafe to return to terminal)
  254. 1847 '
  255. 1848 '   *****  HANGUP AFTER CONNECT (Hayes) -- Jim Gainsley (612)338-6124
  256. 1849 '
  257. 1850 IF NOT EOF(1) THEN Q$=INPUT$(LOC(1),#1):Q$="" ELSE Q$=""  'Purge buffer
  258. 1851 SFRE=900:SLEN=2:GOSUB 50000:CLOSE #1:OPEN COMM$ AS #1:SOUND SD,10:PRINT #1,MODMINIT$:SOUND SD,10:PRINT #1,"ATH0":SOUND SD,25:IF LOC(1)>0 THEN Q$=INPUT$(LOC(1),1):IF INSTR(Q$,"OK") THEN GOTO 1895
  259. 1855 PRINT #1,"+++";:SOUND SD,30
  260. 1860 IF LOC(1)>0 THEN Q$=INPUT$(LOC(1),1) ELSE GOTO 1890
  261. 1865 IF INSTR(Q$,"OK")<>0 THEN Q$="":GOTO 1870 ELSE GOTO 1890
  262. 1870 PRINT #1,"ATH0":SOUND SD,30:Q1=0
  263. 1875 IF LOC(1)>0 THEN Q$=INPUT$(LOC(1),1)
  264. 1880 IF INSTR(Q$,"OK")<>0 OR INSTR(Q$,"NO CARRIER")<>0 THEN Q$="":GOTO 1895          ELSE PRINT"2nd PHASE FAILURE  . . ."
  265. 1885 IF Q1<4 AND INSTR(Q$,"NO CARRIER")=0 GOTO 1870
  266. 1890 Q1=Q1+1: IF INSTR(Q$,"NO CARRIER")<>0 GOTO 1895 ELSE IF Q1<4 THEN PRINT         "1rst PHASE FAILURE . . .  I'M RETRYING . . .":GOTO 1850 ELSE GOSUB 1900:GOTO 1895
  267. 1895 Q1=0:CLOSE#1:OPEN COMM$ AS #1:SFRE=500:SLEN=1:GOSUB 50000:SOUND SD,1:GOSUB 50000:PRINT:PRINT GO$:GOTO 515
  268. 1900 COLOR HI,BG:PRINT "I HAVEN'T RECEIVED HANGUP VERIFICATION AFTER 4 TRIES":       COLOR FG,BG:PRINT"Check Modem CD lite.  If lit, try ALT-H again.":RETURN
  269. 1999 '
  270. 2000 '  *****  COMMAND SUMMARY  *****
  271. 2005 '
  272. 2010 LOCATE 1,39:PRINT CHR$(213)+STRING$(38,205)+CHR$(184)
  273. 2015 LOCATE 2,39:PRINT VL$;"  ===PC-TALK III  COMMAND SUMMARY===  ";VL$
  274. 2020 LOCATE 3,39:PRINT CHR$(195)+STRING$(38,196)+CHR$(180)
  275. 2025 RESTORE 2050:LOCATE 4,39:READ B$:PRINT VL$;" ";CAN$;B$;SPACE$(36-LEN(B$));VL$
  276. 2030 FOR I=5 TO 23:LOCATE I,39:READ B$:PRINT VL$;B$;SPACE$(38-LEN(B$));VL$:NEXT
  277. 2035 LOCATE 24,39:PRINT CHR$(212)+STRING$(38,205)+CHR$(190);
  278. 2040 LOCATE ROW,COL:GOTO 515
  279. 2045 '
  280. 2050 DATA" PrtSc Print Screen Contents
  281. 2055 DATA" ^PrtSc Continuous Printout (^PgUp)
  282. 2060 DATA" XMODEM '=x'  Pacing '=p'  Binary '=b'
  283. 2065 DATA" Shft-TAB  Set/Clear Temp Alt Keys
  284. 2066 DATA" Alt-B  Silent Mode Toggle
  285. 2070 DATA" Alt-C  Clearscreen   Alt-D  Dial Nmbr
  286. 2075 DATA" Alt-E  Echo Toggle   Alt-F  Defaults
  287. 2080 DATA" Alt-G  Get a New Subdirectory
  288. 2085 DATA" Alt-H  Hang up (Disconnect)
  289. 2090 DATA" Alt-I  Set Alt-1/0 from file
  290. 2095 DATA" Alt-K  Set/Clear Func Keys (Alt-J)
  291. 2100 DATA" Alt-L  Default Drv  Alt-M  Messages
  292. 2105 DATA" Alt-O  IBM 3101     Alt-P  Com Parms
  293. 2110 DATA" Alt-Q  Redial Nmbr  Alt-R  Recv File
  294. 2115 DATA" Alt-S  Screendump   Alt-T  Xmit File
  295. 2120 DATA" Alt-U  Save Alt-1/0 Alt-V  View File
  296. 2130 DATA" Alt-W  Set Margin Width Alarm
  297. 2135 DATA" Alt-X  eXit to DOS
  298. 2140 DATA" Alt-Y  Delete a File    Alt-Z  Time
  299. 2145 DATA"Ctrl-End = Send Sustained Break Signal
  300. 2150 '
  301. 2450 '
  302. 2455 '
  303. 2500 '  -- Return Q$ w/ max Len QL
  304. 2505 Q$="":IF QL=0 THEN QL=255
  305. 2510 QI$=INKEY$:IF QI$="" THEN 2510
  306. 2515 IF QI$=CHR$(13) THEN RETURN
  307. 2520 IF QI$<>CHR$(8) THEN 2530 ELSE IF Q$="" THEN GOSUB 50500:GOTO 2510
  308. 2525 IF QI$=CHR$(8) THEN GOSUB 2650:Q$=LEFT$(Q$,LEN(Q$)-1):GOTO 2510
  309. 2530 IF LEN(Q$)=QL THEN GOSUB 50500:GOTO 2510
  310. 2535 IF LEN(QI$)=1 THEN 2545 ELSE IF QI$<>CHR$(0)+CHR$(3) THEN GOSUB 50500:GOTO 2510 ELSE QI$=CHR$(0)
  311. 2545 IF ASC(QI$)>31 OR QI$=CHR$(27) THEN PRINT QI$; ELSE COLOR HI,BG:PRINT CHR$(ASC(QI$)+64);:COLOR FG,BG
  312. 2550 IF QI$=XCR$ THEN Q$=Q$+CHR$(13):GOTO 2510 ELSE Q$=Q$+QI$:GOTO 2510
  313. 2555 '  -- Convert Q$ to Uppercase
  314. 2560 FOR J=1 TO LEN(Q$):P=ASC(MID$(Q$,J,1)):IF P<97 OR P>122 THEN 2570
  315. 2565 MID$(Q$,J,1)=CHR$(P AND 95)
  316. 2570 NEXT:RETURN
  317. 2600 '  -- To/From Line 25
  318. 2605 MSG$=LEFT$(MSG$,77):ROW=CSRLIN:COL=POS(0):LOCATE 25,1:COLOR 31,BG:PRINT CHR$(16);:COLOR BG,FG:PRINT MSG$+SPACE$(77-LEN(MSG$));:COLOR 31,BG:PRINT CHR$(17);:COLOR FG,BG:LOCATE ROW,COL:RETURN
  319. 2606 MSG$=LEFT$(MSG$,78):LOCATE 25,1:COLOR BG,FG:PRINT " "+MSG$+SPACE$(78-LEN(MSG$));:COLOR FG,BG:LOCATE ROW,COL:RETURN
  320. 2650 '  -- Destructive Backspace
  321. 2655 PRINT CHR$(29);" ";CHR$(29);:RETURN
  322. 2700 '  -- Reopen Files Subrout
  323. 2705 CLOSE#2:IF RC THEN OPEN RCV$ FOR APPEND AS #2
  324. 2710 RETURN
  325. 2715 CLOSE#3:IF PR THEN OPEN PRNTPORT$ FOR OUTPUT AS #3
  326. 2720 IF TR THEN CLOSE #3:OPEN TRN$ AS #3 LEN=128:FIELD#3,128 AS X$
  327. 2725 RETURN
  328. 2800 '  -- Clear Menu Line
  329. 2805 ROW=CSRLIN:COL=POS(0)
  330. 2810 EXIT=0:FOR I=1 TO 10:IF ALT$(I)<>"" THEN EXIT=-1:NEXT
  331. 2815 IF EXIT THEN EXIT=0:LOCATE ,,1:GOTO 1210
  332. 2820 IF RC THEN MSG$=RCMSG$:GOTO 2831
  333. 2821 IF TR THEN MSG$=TRMSG$:GOTO 2831
  334. 2825 IF MENU<>0 THEN LOCATE 25,1:PRINT" ";:COLOR BG,FG:PRINT"^PrtSc=prnt PgUp=tran PgDn=recv V=view D=dial E=echo M=mesg X=exit HOME=Help";:COLOR FG,BG:LOCATE ROW,COL:RETURN
  335. 2830 LOCATE 25,1:COLOR FG,BG:PRINT SPACE$(79);:LOCATE ROW,COL:RETURN
  336. 2831 GOSUB 2606:RETURN
  337. 2835 '
  338. 3000 '   *****  RECEIVE A FILE  *****
  339. 3005 '
  340. 3010 IF RC THEN RC=0:RC$="":GOSUB 50500:PRINT:PRINT"===RECEIPT OF FILE ";RCV$;              " TERMINATED===":GOSUB 3247:PRINT:GOSUB 2700:GOSUB 2800:IF MSG THEN             PRINT#1,BL$;CR$;"===FILE RECEIVED===":GOTO 515 ELSE 515
  341. 3015 RC$="":GOSUB 50500:PRINT:PRINT"===RECEIVE A FILE===":DRV$=DRIV$:GOSUB 3110:GOTO 3500
  342. 3020 IF RC$="X" THEN CLOSE#2:KILL RCV$:OPEN RCV$ AS #2 LEN=128:FIELD #2,128 AS X$:GOTO 3030
  343. 3025 IF MSG THEN PRINT#1,BL$;CR$;"===READY TO RECEIVE===
  344. 3030 MSG$=" Receiving "+RCVX$+"  (ALT-R or PgDn to Terminate)":GOSUB 2600
  345. 3035 RC=-1:IF RC$="X" THEN 4500 ELSE 605
  346. 3040 '
  347. 3107 '   *****  FIND FREE DISK SPACE WITH Alt-V  --  Jack Wright  *****
  348. 3108 '          -- Calls to DSK.OBJ
  349. 3109 '
  350. 3110 A=2:B=0:C!=0:IF DRV$="A:" OR DRV$="a:" THEN A=1
  351. 3115 IF DRV$="C:" OR DRV$="c:" THEN A=3
  352. 3116 IF DRV$="D:" OR DRV$="d:" THEN A=4
  353. 3117 IF DRV$="E:" OR DRV$="e:" THEN A=5
  354. 3118 IF DRV$="F:" OR DRV$="f:" THEN A=6
  355. 3132 NAME DRV$+"1" AS DRV$+"1"  'make sure disk is in drive
  356. 3135 CALL DSK(A,B):C!=(C!+B)*512  'see p. 110, compiler manual
  357. 3140 PRINT DRV$;" Drive Free Space = ";C!
  358. 3145 RETURN
  359. 3200 '   *****  TRANSMIT A FILE  *****
  360. 3205 '
  361. 3210 IF TR THEN TR=0:TR$="":MSG1$="===TRANSMISSION OF FILE ":MSG2$=                  " TERMINATED===":GOSUB 3247:GOSUB 50500:PRINT:PRINT MSG1$;TRN$;MSG2$:GOSUB 2715:       GOSUB 2800:IF MSG THEN PRINT#1,CR$;MSG1$;MSG2$,BL$:GOTO 515 ELSE 515
  362. 3215 IF TR THEN TR=0:TR$="":MSG1$="===END OF FILE":MSG2$="===":GOSUB 50500:PRINT:           GOSUB 3247:PRINT MSG1$;" ";TRN$;MSG2$:GOSUB 2715:GOSUB 2800:IF MSG THEN         PRINT#1,"65529 '";MSG1$;MSG2$;BL$:GOTO 515 ELSE 515
  363. 3220 TR$="":GOSUB 50500:PRINT:PRINT"===TRANSMIT A FILE===":GOTO 3500
  364. 3225 CLOSE#3:OPEN TRN$ AS #3 LEN=128:FIELD #3,128 AS X$
  365. 3230 MSG$=" Transmitting "+TRNX$+" (ALT-T or PgUp to Terminate)":IF TR$="X" THEN   MSG$=MSG$+"  # of blocks:" ELSE IF TR$="P" THEN MSG$=MSG$+"  percent remain:"   ELSE MSG$=MSG$+"   min. remain:"
  366. 3235 MSG$=TRMSG$:GOSUB 2600:IF TR$="X" THEN ROW=CSRLIN:COL=POS(0):LOCATE 25,74:CNT!=FIX(LOF(3)/128):FLN!=LOF(3)/128:IF CNT!=FLN! THEN PRINT CNT!;:LOCATE ROW,COL ELSE PRINT CNT!+1;:LOCATE ROW,COL:GOTO 3245
  367. 3240 IF MSG THEN PRINT#1,CR$;"0 '===START OF FILE===";BL$
  368. 3245 TR=-1:FLN!=LOF(3):IF TR$<>"X" THEN 4000 ELSE 4700
  369. 3247 '
  370. 3248 GOSUB 40000:RETURN
  371. 3250 '
  372. 3400 '   *****  VIEW A FILE  *****
  373. 3401 '
  374. 3405 DRV$=DRIV$:GOSUB 3110 'Rem if def. drive free spc isn't wanted ea. time
  375. 3410 GOSUB 50500:PRINT:PRINT"===VIEW A FILE===":GOTO 3500
  376. 3415 MSG$=" Viewing "+VEWX$+"  Press <space> to continue  (Alt-V to terminate)"      :GOSUB 2600:PRINT:PRINT:PRINT
  377. 3420 WHILE NOT EOF(3):FOR I=1 TO 20:LINE INPUT#3,X$:J=LEN(X$):IF J<80 THEN PRINT X$ ELSE PRINT X$;:IF J>80 THEN I=I+FIX(J/80)
  378. 3421 IF PR THEN LPRINT X$
  379. 3425 NEXT
  380. 3430 Q$=INKEY$:IF Q$="" THEN 3430 ELSE IF Q$=" " THEN 3420 ELSE IF Q$=CHR$(0)+CHR$(47) THEN 3445 ELSE GOSUB 50500:GOTO 3430
  381. 3435 WEND
  382. 3440 GOSUB 50500:PRINT:PRINT"===END OF FILE ";VEW$;" ===":GOTO 3450
  383. 3445 GOSUB 50500:PRINT:PRINT"===VIEWING OF FILE ";VEW$;" TERMINATED===
  384. 3450 GOSUB 2715:GOSUB 2800:GOTO 515
  385. 3455 '
  386. 3500 '   ***** FILE SPECS  *****
  387. 3505 '
  388. 3510 EXIT=0:PRINT"   specification:";
  389. 3515 Q$=INKEY$:IF Q$="" THEN 3515 ELSE IF Q$=CR$ OR Q$=BS$ THEN FIL$="":PRINT:GOTO 3540
  390. 3520 IF LEN(Q$)>1 THEN Q=ASC(MID$(Q$,2,1)):IF Q>=59 AND Q<=68 THEN Q$=K$(Q-58) ELSE IF Q>=104 AND Q<=113 THEN Q$=K$(Q-93) ELSE IF Q>=84 AND Q<=103 THEN Q$=K$(Q-63) ELSE IF Q>=120 AND Q<=129 THEN Q$=ALT$(Q-119) ELSE GOSUB 50500:GOTO 3515
  391. 3525 IF Q$<>" " THEN PRINT Q$;:QL=128:GOSUB 2510:GOSUB 2555:FIL$=Q$:PRINT:LOCATE,,1:GOTO 3540
  392. 3530 IF EX=19 THEN FIL$=RCVX$ ELSE IF EX=20 THEN FIL$=TRNX$ ELSE IF EX=47 THEN FIL$=VEWX$
  393. 3535 Q$=FIL$:PRINT Q$;:QL=128:GOSUB 2510:GOSUB 2555:FIL$=Q$:PRINT:LOCATE,,1
  394. 3540 IF FIL$="" THEN GOSUB 50500:PRINT"===CANCELLED===":GOTO 515
  395. 3545 IF LEFT$(FIL$,1)="?" THEN GOSUB 3625:GOTO 3510
  396. 3550 P=INSTR(FIL$,":"):IF P=0 THEN FIL$=DRIV$+FIL$
  397. 3555 IF EX=19 THEN RCVX$=FIL$ ELSE IF EX=20 THEN TRNX$=FIL$ ELSE IF EX=47 THEN VEWX$=FIL$
  398. 3560 P=INSTR(FIL$,"="):IF P=0 THEN IF EX<>20 OR PC$="" OR EXIT=-1 THEN 3595 ELSE EXIT=-1:Q$=FIL$+PC$:LOCATE CSRLIN-1,18:GOSUB 50500:GOTO 3525
  399. 3565 Q$=RIGHT$(FIL$,LEN(FIL$)-P):FIL$=LEFT$(FIL$,P-1)
  400. 3570 IF Q$="B" THEN TR$="B"
  401. 3575 IF Q$="X" THEN IF EX=19 THEN RC$="X" ELSE IF EX=20 THEN TR$="X
  402. 3580 IF LEFT$(Q$,1)="P" THEN TR$="P":PROMPT$=RIGHT$(Q$,LEN(Q$)-1):DEL!=VAL(PROMPT$)
  403. 3585 IF TR$="B" OR TR$="X" OR RC$="X" THEN IF DTA$<>"8" THEN GOSUB 50500:PRINT              "*** Automatically converting to 8 databits for XMODEM ***"
  404. 3590 IF TR$="X" OR RC$="X" THEN IF NS<>0 THEN GOSUB 50500:PRINT"*** Stripping disabled for XMODEM ***":NS=0
  405. 3595 IF EX=19 THEN CLOSE#2:OPEN FIL$ FOR APPEND AS #2 ELSE CLOSE#3:OPEN FIL$         FOR INPUT AS #3
  406. 3600 PRINT STRING$(18+LEN(FIL$),61):IF EX=19 THEN RCV$=FIL$:GOTO 3020
  407. 3605 IF EX=20 THEN TRN$=FIL$:GOTO 3225
  408. 3610 IF EX=47 THEN VEW$=FIL$:GOTO 3415
  409. 3615 IF EX=21 THEN 3915
  410. 3620 '  -- File Directory Subroutine
  411. 3625 IF LEN(FIL$)=1 THEN FIL$=DRIV$+"*.*":GOTO 3640 ELSE FIL$=RIGHT$(FIL$,LEN(FIL$)-1):IF LEFT$(FIL$,1)=" " THEN FIL$=RIGHT$(FIL$,LEN(FIL$)-1)
  412. 3630 P=INSTR(FIL$,":"):IF P=0 THEN FIL$=DRIV$+FIL$
  413. 3635 IF LEN(FIL$)=P THEN FIL$=FIL$+"*.*
  414. 3640 DRV$=LEFT$(FIL$,2):PRINT:GOSUB 3110:FILES FIL$:PRINT
  415. 3645 RETURN
  416. 3650 '
  417. 3800 '   *****  SCREENDUMP  *****
  418. 3805 '
  419. 3810 SFRE=440:SLEN=2:GOSUB 50000:CLOSE#2:OPEN DUMP$ FOR APPEND AS #2:MSG$=" Appending to "+DUMP$+" at "+TIME$:GOSUB 2600
  420. 3815 FOR I=1 TO 24:Y$="":FOR J=1 TO 79:X=SCREEN(I,J):Y$=Y$+CHR$(X):NEXT J:PRINT      #2,Y$:NEXT I:PRINT#2,STRING$(79,45);CR$;LF$;"*** PC-TALK III SCREENDUMP - "     ;DATE$;" at ";TIME$;" ***";CR$;LF$;STRING$(79,61):CLOSE#2
  421. 3820 SFRE=660:SLEN=2:GOSUB 50000:GOSUB 50500:GOSUB 2705:GOSUB 2800:LOCATE ROW,COL:GOTO 515
  422. 3825 '
  423. 3900 ' Delete File
  424. 3905 '
  425. 3910 GOSUB 50500:PRINT:PRINT"===DELETE A FILE===":GOTO 3500
  426. 3915 PRINT"***The first 5 lines are:":FOR I=1 TO 5:IF NOT EOF(3) THEN LINE INPUT#3,X$:PRINT X$
  427. 3920 NEXT:PRINT"***ARE YOU SURE (y/n)?";:Q$=INPUT$(1):PRINT Q$:GOSUB 2555:IF Q$="Y" THEN CLOSE#3:KILL FIL$:GOSUB 50500:PRINT" (deleted)":GOTO 3930
  428. 3925 PRINT" (not deleted)":PRINT GO$:GOTO 515
  429. 3930 GOSUB 2715:PRINT GO$:GOTO 515
  430. 3935 '
  431. 4000 '   *****  TRANSMIT  *****
  432. 4005 '
  433. 4010 IF TR$="B" THEN PRINT"(sending file as binary...)
  434. 4015 RATE!=VAL(BAU$)*6:CNT!=0:ROW=CSRLIN:COL=POS(0):GOTO 4060
  435. 4020 LOCATE 25,74:IF TR$<>"P" THEN PRINT USING"###.#";(FLN!-(CNT!*128))/RATE!; ELSE PRINT USING".##";(FLN!-CNT!*128)/FLN!;
  436. 4025 GET#3,CNT!:Y$=X$:LOCATE ROW,COL
  437. 4030 IF TR$="P" THEN GOSUB 4400:IF NOT ABORT THEN 4050 ELSE ABORT=0:GOTO 1500
  438. 4035 PRINT#1,Y$;:IF TR$="B" THEN 4050
  439. 4040 P=INSTR(1,Y$,LF$):IF P=0 THEN 4045 ELSE Y$=LEFT$(Y$,P-1)+RIGHT$(Y$,LEN(Y$)-P):GOTO 4040
  440. 4045 FOR I=1 TO 128:PRINT MID$(Y$,I,1);:NEXT
  441. 4050 ROW=CSRLIN:COL=POS(0):GOSUB 4070:B$=INKEY$:IF B$="" THEN 4060
  442. 4055 IF LEN(B$)>1 THEN 1500
  443. 4060 CNT!=CNT!+1:IF CNT!*128<FLN! THEN 4020 ELSE GET#3,CNT!:Y$=X$:GOTO 4200
  444. 4065 '  -- XON/XOFF Subroutine
  445. 4070 IF EOF(1) THEN 4085 ELSE A$=INPUT$(LOC(1),#1)
  446. 4075 P=INSTR(1,A$,XF$):IF P<>0 THEN HLT=-1:COLOR HI,BG:PRINT"<<XOFF>>";:COLOR FG,BG
  447. 4080 IF HLT THEN P=INSTR(1,A$,XN$):IF P=0 THEN 4085 ELSE HLT=0:RETURN
  448. 4085 IF HLT THEN Q$=INKEY$:IF Q$<>"" THEN IF LEN(Q$)<>2 THEN 4070 ELSE IF ASC(RIGHT$(Q$,1))=24 THEN HLT=0:RETURN ELSE 4070 ELSE 4070
  449. 4090 RETURN
  450. 4200 '  -- Transmit last block
  451. 4205 I=0:CNT!=(CNT!-1)*128
  452. 4210 I=I+1:CNT!=CNT!+1:IF I>255 THEN 4230 ELSE Z$=MID$(Y$,I,1)
  453. 4215 IF TR$="B" THEN IF CNT!<=FLN! THEN 4235 ELSE 4230
  454. 4220 IF Z$<>EF$ THEN 4235 ELSE 4230
  455. 4225 IF CNT!<=FLN! THEN 4235
  456. 4230 IF EOF(1) THEN 3215 ELSE DMMY$=INPUT$(LOC(1),#1):GOTO 4230
  457. 4235 IF TR$="P" THEN IF Z$=LF$ THEN 4210
  458. 4240 PRINT#1,Z$;:IF TR$="P" THEN IF Z$=CR$ THEN PRINT Z$;:GOSUB 4425:GOTO 4210
  459. 4245 IF TR$="B" OR Z$=LF$ THEN 4210
  460. 4250 PRINT Z$;:GOTO 4210
  461. 4400 '  -- Line pacing subrout
  462. 4405 FOR I=1 TO LEN(Y$):Z$=MID$(Y$,I,1):IF Z$=LF$ THEN 4415 ELSE IF Z$<>CR$ THEN PRINT#1,Z$;:PRINT Z$;:GOTO 4415 ELSE PRINT #1," "+CR$;:PRINT CR$;:B$="":GOSUB 4420
  463. 4410 IF ABORT THEN RETURN
  464. 4415 NEXT:RETURN
  465. 4420 IF LEN(B$)>1 THEN ABORT=-1:RETURN
  466. 4425 IF (INP(LSR) AND 96)<>96 THEN 4425
  467. 4430 IF DEL!>0 THEN SOUND SD,18*DEL!:SOUND SD,1:RETURN
  468. 4435 Z$="":WHILE NOT EOF(1):Z$=Z$+INPUT$(LOC(1),#1):WEND:PRINT Z$;:IF Z$="" THEN Z$=CHR$(0) ELSE IF LEN(Z$)>128 THEN Z$=""
  469. 4440 P=INSTR(Z$,PROMPT$):B$=INKEY$:IF P<>0 OR B$=" " THEN RETURN ELSE 4420
  470. 4445 '
  471. 4500 '   *****  RECEIVE with XMODEM  *****
  472. 4505 '
  473. 4510 PRINT"===RECEIVE FILE WITH XMODEM===":PRINT
  474. 4513 OPAR$=PAR$:ODTA$=DTA$:PAR$="N":DTA$="8":GOSUB 40000:PAR$=OPAR$:DTA$=ODTA$
  475. 4515 Y$="":BLK=1:SEC=1:CK=0:ECNT=0
  476. 4520 PRINT"***Holding for Start...":GOSUB 4975:PRINT#1,NAK$;
  477. 4525 GOSUB 4925:IF ABORT THEN 4645 ELSE 4535
  478. 4530 GOSUB 4905:IF Z$="" THEN 4545
  479. 4535 Y$=Y$+Z$:IF LEN(Y$)<=131 THEN 4530
  480. 4540 '  -- Check block
  481. 4545 IF LEN(Y$)=132 THEN LSET X$=MID$(Y$,4,128):N=132:GOTO 4580
  482. 4550 IF LEN(Y$)=131 THEN LSET X$=MID$(Y$,3,128):N=131:GOTO 4580
  483. 4555 IF LEN(Y$)>132 THEN PRINT"**Long  Block in #";BLK:GOTO 4615
  484. 4560 IF Y$=EOT$ THEN 4635
  485. 4565 IF Y$=CAN$ THEN 4640
  486. 4570 IF Y$="" THEN PRINT"***Timeout":GOSUB 4975:PRINT #1,NAK$:GOTO 4525
  487. 4575 PRINT"**Short Block in #";BLK:GOTO 4615
  488. 4580 IF (ASC(MID$(Y$,1,1)) AND ASC(MID$(Y$,2,1)) AND ASC(MID$(Y$,3,1)))<>0 THEN PRINT"**Error in SOH":Y$="":PRINT #1,NAK$:GOTO 4525
  489. 4585 IF ASC(MID$(Y$,2,1))=SEC-1 THEN PRINT"**Requesting Next Block":PRINT#1,ACK$:GOTO 4520
  490. 4590 IF SEC<>ASC(MID$(Y$,2,1)) THEN PRINT"**Block # Error in #";BLK:GOTO 4615
  491. 4595 IF (SEC XOR 255)<>ASC(MID$(Y$,3,1)) THEN PRINT"**Complement Error in #";BLK:GOTO 4615
  492. 4600 FOR I=1 TO 128:CK=CK+ASC(MID$(X$,I,1)):NEXT
  493. 4605 IF (CK AND 255)=(ASC(MID$(Y$,N,1))) THEN 4620
  494. 4610 PRINT"**Checksum Error in #";BLK:
  495. 4615 PRINT#1,NAK$;:ECNT=ECNT+1:IF ECNT<12 THEN 4625 ELSE 4645
  496. 4620 PRINT"Received Block #";BLK;:SEC=255 AND (SEC+1):PUT#2,BLK:BLK=BLK+1:PRINT#1,ACK$;:PRINT"- verified":ECNT=0
  497. 4625 Y$="":CK=0:GOSUB 4965:IF ABORT THEN 4645 ELSE 4530
  498. 4630 '  -- Terminate
  499. 4635 PRINT"***End of File - verified":PRINT#1,ACK$;:GOSUB 40000:GOTO 3010
  500. 4640 PRINT"***Cancelled by Transmitter":GOSUB 40000:GOTO 3010
  501. 4645 PRINT"***Cancelled by Receiver":PRINT#1,CAN$;:GOSUB 4975:GOSUB 40000:GOTO 3010
  502. 4650 '
  503. 4700 '   *****  TRANSMIT with XMODEM
  504. 4705 '
  505. 4710 PRINT"===TRANSMIT FILE WITH XMODEM===":PRINT
  506. 4713 OPAR$=PAR$:ODTA$=DTA$:PAR$="N":DTA$="8":GOSUB 40000:PAR$=OPAR$:DTA$=ODTA$
  507. 4715 SEC=0:BLK=0:CNT!=0:ECNT=0:EOT=0:ETT=0:GOSUB 4815
  508. 4720 PRINT"***Holding for Start...":GOSUB 4975:ABORT=0:SECZ=0:GOSUB 4985
  509. 4725 WHILE NOT EOF(1):Z$=INPUT$(1,#1)
  510. 4730 IF Z$=NAK$ THEN 4800
  511. 4735 IF Z$=CAN$ THEN 4855
  512. 4740 WEND:GOSUB 4965:IF ABORT THEN 4860
  513. 4745 GOSUB 4990:IF NOT TENSEC THEN 4725 ELSE GOSUB 4995:GOTO 4725
  514. 4750 '  -- Hold for ACK
  515. 4755 ABORT=0:SECZ=0:GOSUB 4985
  516. 4760 WHILE NOT EOF(1):Z$=INPUT$(LOC(1),#1)
  517. 4765 IF Z$=ACK$ THEN ECNT=0:PRINT "- verified ":IF NOT EOT THEN 4800 ELSE IF NOT ETT THEN 4845 ELSE 4850
  518. 4770 IF Z$=NAK$ THEN ECNT=ECNT+1:IF ECNT>12 THEN 4860 ELSE IF NOT EOT THEN 4805 ELSE 4845
  519. 4775 IF Z$=CAN$ THEN 4855
  520. 4780 WEND:GOSUB 4965:IF ABORT THEN 4860
  521. 4785 GOSUB 4990:IF NOT TENSEC THEN 4760
  522. 4790 GOSUB 4995:IF NOT ABORT THEN IF NOT EOT THEN 4805 ELSE 4845 ELSE 4860
  523. 4800 A$=Y$:PRINT"Sending Block #";BLK;:PRINT#1,A$;:IF CNT!<FLN! THEN GOSUB 4815:GOTO 4755 ELSE EOT=-1:GOTO 4755
  524. 4805 ECNT=ECNT+1:IF ECNT>12 THEN 4860 ELSE PRINT:PRINT"***Re-sending block...";:PRINT#1,A$;:GOTO 4755
  525. 4810 '  -- Build Block
  526. 4815 BLK=BLK+1:CNT!=CNT!+128:GET#3,BLK:Y$=X$:IF CNT!<=FLN! THEN 4825
  527. 4820 Y$=MID$(Y$,1,128-(CNT!-FLN!))+STRING$(CNT!-FLN!,CHR$(0))
  528. 4825 CK=0:FOR I=1 TO LEN(Y$):CK=CK+ASC(MID$(Y$,I,1)):NEXT:CK=(CK AND 255)
  529. 4830 IF CK>256 THEN CK=CK-256:GOTO 4830
  530. 4835 SEC=(255 AND BLK):Y$=SOH$+CHR$(SEC)+CHR$(SEC XOR 255)+Y$+CHR$(CK):RETURN
  531. 4840 '  -- Terminate
  532. 4845 PRINT#1,EOT$;:PRINT"***Sending End Marker ";:ETT =-1:GOTO 4755
  533. 4850 CLOSE #3:GOTO 3215
  534. 4855 PRINT:PRINT"***Cancelled by Receiver":CLOSE#3:GOTO 3210
  535. 4860 PRINT:PRINT"***Cancelled by Transmitter":CLOSE#3:PRINT#1,CAN$;:GOTO 3210
  536. 4865 '
  537. 4900 '  XMODEM Subroutines
  538. 4905 Z$="":ZA=0
  539. 4910 IF NOT EOF(1) THEN Z$=INPUT$(LOC(1),#1):RETURN ELSE SOUND SD,1:ZA=ZA+1
  540. 4915 IF ZA>72 THEN RETURN ELSE 4910
  541. 4920 '  -- Hold for SOH
  542. 4925 ABORT=0:SECZ=0:GOSUB 4985
  543. 4930 GOSUB 4905:GOSUB 4965:IF ABORT THEN RETURN
  544. 4935 IF LEFT$(Z$,1)=SOH$ THEN RETURN
  545. 4940 IF LEFT$(Z$,1)=EOT$ THEN RETURN
  546. 4945 IF LEFT$(Z$,1)=CAN$ THEN RETURN
  547. 4950 GOSUB 4975:PRINT#1,NAK$;
  548. 4955 GOSUB 4990:IF NOT TENSEC THEN 4955 ELSE GOSUB 4995:GOTO 4930
  549. 4960 '  -- Test for Abort
  550. 4965 B$=INKEY$:IF LEN(B$)<2 THEN RETURN ELSE Q$=MID$(B$,2,1):IF Q$=CHR$(19) OR       Q$=CHR$(20) OR Q$=CHR$(73) OR Q$=CHR$(81) THEN ABORT=-1:RETURN ELSE RETURN
  551. 4970 '  -- Purge Buffer
  552. 4975 WHILE NOT EOF(1):Z$=INPUT$(LOC(1),#1):WEND:RETURN
  553. 4980 '  -- Set/Check Delay
  554. 4985 SECX=60*VAL(MID$(TIME$,4,2))+VAL(MID$(TIME$,7,2)):RETURN
  555. 4990 TENSEC=0:SECY=60*VAL(MID$(TIME$,4,2))+VAL(MID$(TIME$,7,2)):IF SECY-SECX<10 THEN RETURN ELSE TENSEC=-1:RETURN
  556. 4995 IF SECZ<9 THEN GOSUB 4985:SECZ=SECZ+1:RETURN ELSE ABORT=-1:RETURN
  557. 4996 '
  558. 5000 '   *****  COMM PARAMS  *****
  559. 5005 '
  560. 5010 GOSUB 50500:CLS:PRINT:PRINT"===COMMUNICATIONS PARAMETERS===
  561. 5015 PRINT:PRINT"Present parameters: ";:GOSUB 5100:PRINT"Options:
  562. 5020 PRINT"   1 -  300,E,7,1  (text)      2 -  300,N,8,1  (binary)
  563. 5025 PRINT"   3 - 1200,E,7,1  (text)      4 - 1200,N,8,1  (binary)
  564. 5030 PRINT SPACE$(15);"F - reset params to defaults
  565. 5035 PRINT SPACE$(15);"X - exit to terminal
  566. 5040 PRINT"Choose: ";
  567. 5045 Q$=INPUT$(1):GOSUB 2555
  568. 5050 IF Q$="X" THEN PRINT Q$:PRINT:PRINT"(present parameters still in effect)":      GOTO 5095
  569. 5055 IF Q$="F" THEN PRINT Q$:GOSUB 5815:PRINT:PRINT"Parameters reset to:";:GOSUB 5100:GOTO 5095
  570. 5060 Q=VAL(Q$):IF Q<1 OR Q>4 THEN GOSUB 50500:GOTO 5045 ELSE PRINT Q
  571. 5065 BAU$="1200":PAR$="N":DTA$="8":STP$="1"
  572. 5070 IF Q=2 THEN PAR$="N":DTA$="8
  573. 5075 IF Q=3 THEN BAU$="1200
  574. 5080 IF Q=4 THEN BAU$="1200":PAR$="N":DTA$="8
  575. 5085 LOCATE ,,1:COMM$=COMMPORT$+BAU$+","+PAR$+","+DTA$+","+STP$+COMMINIT$:CLOSE#1:OPEN COMM$ AS #1
  576. 5090 PRINT:PRINT"New parameters are: ";:GOSUB 5100
  577. 5095 IF MDFLG THEN RETURN ELSE PRINT GO$:GOSUB 2800:GOTO 515
  578. 5100 COLOR BG,FG:PRINT MID$(COMM$,6,10);:COLOR FG,BG:PRINT:PRINT
  579. 5105 PRINT"Echo-";:IF ECH=-1 THEN PRINT"Y"; ELSE PRINT"N";
  580. 5110 PRINT" Mesg-";:IF MSG=-1 THEN PRINT"Y"; ELSE PRINT"N";
  581. 5115 PRINT" Strip-";:IF NS=0 THEN PRINT"N"; ELSE PRINT USING"#";NS;
  582. 5120 PRINT" Pace-";:IF PC$="" THEN PRINT"N" ELSE PRINT PC$
  583. 5125 IF NS=0 THEN PRINT:RETURN ELSE FOR I=1 TO NS:PRINT"Strip #";:PRINT USING"#";I;:PRINT" - /";:PRINT USING"###";ASC(S$(I));:PRINT"/";:IF R$(I)="" THEN PRINT"000"; ELSE PRINT USING"###";ASC(R$(I));
  584. 5130 PRINT"/":NEXT:PRINT:RETURN
  585. 5135 '
  586. 5200 '   *****  NEW DEFAULTS  *****
  587. 5205 '
  588. 5210 CLS:GOSUB 50500:PRINT"===SET NEW DEFAULTS===":PRINT:COLOR BG,FG:PRINT" Present program defaults:";SPACE$(53);:COLOR FG,BG:EXIT=0
  589. 5215 FOR I=1 TO DFNUM:J=I+4:P=1:IF I>15 THEN J=I-11:P=32
  590. 5220 LOCATE J,P,0:PRINT DP$(I);:LOCATE J,P+16:IF D$(I)>=" " THEN PRINT D$(I); ELSE IF D$(I)="" THEN PRINT "''"; ELSE IF D$(I)=CHR$(0) THEN PRINT "0"; ELSE COLOR HI,BG:PRINT CHR$(ASC(D$(I))+64);:COLOR FG,BG
  591. 5225 IF I<15 THEN PRINT SPACE$(12-LEN(D$(I))); ELSE PRINT SPACE$(30-LEN(D$(I)));
  592. 5230 NEXT:LOCATE ,,1:IF EXIT THEN 5280 ELSE FOR I=1 TO DFNUM:DT$(I)=D$(I):NEXT
  593. 5231 '
  594. 5235 LOCATE 21,1:COLOR BG,FG:PRINT" Enter ";ENT$;" to leave unchanged - <space>";ENT$;" for 'null' value - <ESC>";ENT$;" to quit ":COLOR FG,BG
  595. 5240 PRINT"*** Enter new values":ABORT=0:FOR I=1 TO DFNUM:J=I+4:P=1:IF I>15 THEN J=I-11:P=32
  596. 5245 IF ABORT THEN 5265
  597. 5250 IF D$(I)<>"" THEN LOCATE J,P+17+LEN(D$(I)) ELSE LOCATE J,P+19
  598. 5255 IF I>15 THEN QL=16 ELSE QL=4
  599. 5260 GOSUB 2500:IF Q$=CHR$(27) THEN GOSUB 2655:GOSUB 2655:ABORT=-1 ELSE IF           Q$<>"" THEN DT$(I)=Q$:IF DT$(I)=" " THEN DT$(I)=""
  600. 5265 NEXT
  601. 5270 GOSUB 5295:PRINT"*** New values ok (y/n)?";:Q$=INPUT$(1):PRINT Q$:GOSUB 2555:IF Q$="N" THEN GOSUB 5295:LOCATE 21,1:PRINT SPACE$(79);:LOCATE 21,1:PRINT"(Default Routine Cancelled)":GOTO 5290 ELSE FOR I=1 TO DFNUM:D$(I)=   DT$(I):NEXT
  602. 5271 '
  603. 5275 EXIT=-1:GOSUB 5295:PRINT"*** Make these changes permanent (y/n)?";:Q$=INPUT$(1):PRINT Q$+" ...wait";:GOSUB 2555:IF Q$="Y" THEN GOSUB 5440:GOTO 5215 ELSE GOSUB 5600:GOTO 5215
  604. 5280 GOSUB 5815:CLOSE#1:OPEN COMM$ AS #1
  605. 5285 GOSUB 5295:LOCATE CSRLIN-1,1:PRINT SPACE$(79);:LOCATE CSRLIN,1
  606. 5290 COLOR FG,BG,BG:PRINT GO$:GOSUB 2800:GOTO 515
  607. 5295 LOCATE 22,1:PRINT SPACE$(79);:LOCATE 22,1:RETURN
  608. 5400 '  -- Create Default File
  609. 5405 RESTORE 5410:FOR I=1 TO DFNUM:READ DP$(I),D$(I):NEXT:GOSUB 5440:GOTO 300
  610. 5410 DATA Baud rate,300,Parity,E,Data bits,7,Stop bits,1,Echo,N,Messages,N
  611. 5415 DATA"Strip #1",0,Replace #1,0,"Strip #2",0,Replace #2,0,"Strip #3",0,Replace #3,0,Pacing p=,,Logged drive,"B:",Margin width,70
  612. 5420 DATA Screendump file,"B:SCRNDUMP.PCT",Redial delay,20,Connect prompt,CONNECT
  613. 5425 DATA Line 25 help,Y,Foreground,7,Background,0,High inten.,15
  614. 5430 DATA "Print port","LPT1:","Print init.",,"Print width",80
  615. 5435 DATA Comm. port,"COM1:",Comm. init.,",CS,DS",Modem init.,,C/R subst.,}
  616. 5440 CLOSE#1:OPEN FFIL$ FOR OUTPUT AS #1:WRITE#1,IFIL$:FOR I=1 TO DFNUM:WRITE#1,DP$(I),D$(I):NEXT:WRITE#1,IFIL$:GOSUB 5600:RETURN
  617. 5600 '  -- Update Values
  618. 5605 BAU$=D$(1):PAR$=D$(2):DTA$=D$(3):STP$=D$(4)
  619. 5610 I=5:GOSUB 5805:IF D$(5)="Y" THEN DECH=-1 ELSE D$(5)="N":DECH=0
  620. 5615 I=6:GOSUB 5805:IF D$(6)="Y" THEN DMSG=-1 ELSE D$(6)="N":DMSG=0
  621. 5620 DNS=0:FOR J=1 TO 3:I=2*J+5:GOSUB 5810
  622. 5625 DS$(J)=CHR$(VAL(D$(I))):IF DS$(J)<>CHR$(0) THEN DNS=DNS+1 ELSE D$(I)="0"
  623. 5630 NEXT:FOR J=1 TO 3:I=2*J+6:GOSUB 5810
  624. 5635 DR$(J)=CHR$(VAL(D$(I))):IF DR$(J)=CHR$(0) THEN DR$(J)="":D$(I)="0"
  625. 5640 NEXT:IF D$(13)<>"" THEN DPC$="=P"+D$(13) ELSE DPC$=""
  626. 5645 D$(14)=LEFT$(D$(14),1)+":":DRIV$=D$(14)
  627. 5650 MARG=VAL(D$(15)):DUMP$=D$(16):QDELAY=VAL(D$(17)):CONNECT$=D$(18)
  628. 5655 I=19:GOSUB 5805:IF D$(19)="N" THEN MENU=0 ELSE MENU=-1
  629. 5660 FG=VAL(D$(20)):BG=VAL(D$(21)):HI=VAL(D$(22))
  630. 5665 PRNTPORT$=D$(23):PRNTINIT$=D$(24):WIDTH PRNTPORT$,VAL(D$(25))
  631. 5670 I=18:GOSUB 5805:COMMPORT$=D$(26):IF COMMPORT$="COM1:" THEN LSR=&H3FD:LCR=&H3FB ELSE LSR=&H2FD:LCR=&H2FB
  632. 5675 COMMINIT$=D$(27):DCOMM$=COMMPORT$+BAU$+","+PAR$+","+DTA$+","+STP$+COMMINIT$:MODMINIT$=D$(28):XCR$=LEFT$(D$(29),1)
  633. 5680 GOSUB 5815:RETURN
  634. 5800 '  -- Default Subroutine
  635. 5805 Q$=D$(I):GOSUB 2555:D$(I)=Q$:RETURN
  636. 5810 IF VAL(D$(I))<0 OR VAL(D$(I))>255 THEN D$(I)="0":RETURN ELSE RETURN
  637. 5815 COMM$=DCOMM$
  638. 5820 ECH=DECH:MSG=DMSG:NS=DNS:FOR J=1 TO 3:I=2*J+5:S$(J)=DS$(J):R$(J)=DR$(J):        NEXT:PC$=DPC$:RETURN
  639. 5825 '
  640. 6000 '   *****  DIALING DIRECTORY  *****
  641. 6005 '
  642. 6010 GOSUB 50500:CLOSE#2:OPEN DFIL$ AS #2:IF DPAGE=0 THEN DPAGE=1
  643. 6015 FIELD #2,24 AS N$,36 AS R$,2 AS X$,4 AS B$,1 AS P$,1 AS D$,1 AS S$,1 AS E$,1 AS M$,2 AS T$,26 AS C$,3 AS L$,2 AS G$
  644. 6020 GET#2,1:IF LEFT$(N$,LEN(IFIL$))<>IFIL$ THEN I1=1:I2=60:GOSUB 6870
  645. 6025 '  -- Write to Screen
  646. 6030 I1=(DPAGE-1)*15+1:I2=(DPAGE-1)*15+15
  647. 6035 CLS:LOCATE 1,1,0:PRINT"===DIALING DIRECTORY "DPAGE"===
  648. 6040 GET#2,2:MODM$=RIGHT$(R$,CVI(X$)):LOCATE 1,30:PRINT" Modem dialing command = "MODM$
  649. 6045 GET#2,3:SERV1$=RIGHT$(R$,CVI(X$)):LOCATE 2,28:PRINT"Long distance service +# = "LEFT$(SERV1$,24)
  650. 6050 GET#2,4:SERV2$=RIGHT$(R$,CVI(X$)):LOCATE 3,50:PRINT"-# = "LEFT$(SERV2$,24)
  651. 6055 LOCATE 4,1:COLOR BG,FG:PRINT"   Name"SPACE$(29)"Phone #   Comm Param  Echo Mesg Strip Pace ";:COLOR FG,BG:LOCATE 5,1
  652. 6060 FOR I=I1 TO I2:GET#2,I+4
  653. 6065 PRINT USING "##";LOC(2)-4;:PRINT"-";N$;"  ";RIGHT$(R$,14);"   ";B$;"-";P$;"-";D$;"-";S$;"    ";E$;"    ";M$;"   ";:IF CVI(T$)=0 THEN PRINT " N "; ELSE PRINT CVI(T$);
  654. 6070 PRINT"  ";:IF CVI(G$)=0 THEN PRINT "  N" ELSE PRINT "p="+L$
  655. 6075 NEXT
  656. 6080 '  -- Initial Choice
  657. 6085 LOCATE 21,1:PRINT"Enter Dir. #:             | or...
  658. 6090 LOCATE 21,39:PRINT"Enter: R to revise or add to directory
  659. 6095 LOCATE 22,46:PRINT"M for manual dialing
  660. 6100 LOCATE 23,42:PRINT"F / B to page through directory
  661. 6105 LOCATE 24,46:PRINT"X to exit to terminal";
  662. 6110 LOCATE 25,27:PRINT"| For long distance service, precede entry # with +/-";
  663. 6115 LOCATE 21,14,1:QL=3:GOSUB 2500:GOSUB 2555
  664. 6120 IF LEFT$(Q$,1)="+" THEN SERV1=-1:Q$=RIGHT$(Q$,LEN(Q$)-1) ELSE SERV1=0
  665. 6125 IF LEFT$(Q$,1)="-" THEN SERV2=-1:Q$=RIGHT$(Q$,LEN(Q$)-1) ELSE SERV2=0
  666. 6130 IF Q$="R" THEN 6400
  667. 6135 IF Q$="F" THEN IF DPAGE=4 THEN DPAGE=1:GOTO 6030 ELSE DPAGE=DPAGE+1:GOTO 6030
  668. 6140 IF Q$="B" THEN IF DPAGE=1 THEN DPAGE=4:GOTO 6030 ELSE DPAGE=DPAGE-1:GOTO 6030
  669. 6145 IF Q$="X" THEN CLOSE#2:GOSUB 2700:CLS:LOCATE 1,1,1:PRINT GO$:GOSUB 2800:GOTO 515
  670. 6150 IF Q$="M" THEN CLOSE#2:GOSUB 2700:CLS:LOCATE 1,1,1:GOSUB 6305:GOSUB 2800:GOTO 515
  671. 6155 IF VAL(Q$)<1 OR VAL(Q$)>60 THEN GOSUB 50500:LOCATE 21,14:PRINT SPACE$(LEN(Q$))        :GOTO 6115
  672. 6200 '  -- Dial Entry
  673. 6205 GET#2,VAL(Q$)+4:BAU$=B$:PAR$=P$:DTA$=D$:STP$=S$:IF LEFT$(BAU$,1)=" " THEN BAU$=RIGHT$(BAU$,3)
  674. 6210 COMM$=COMMPORT$+BAU$+","+PAR$+","+DTA$+","+STP$+COMMINIT$
  675. 6215 CLOSE#1:OPEN COMM$ AS #1
  676. 6220 IF E$="Y" THEN ECH=-1 ELSE ECH=0
  677. 6225 IF M$="Y" THEN MSG=-1 ELSE MSG=0
  678. 6230 NS=CVI(T$):IF NS=0 THEN 6255
  679. 6235 FOR I=0 TO NS-1:P=VAL(MID$(C$,I*8+1,3)):IF P>255 THEN P=0
  680. 6240 J=VAL(MID$(C$,I*8+5,3)):IF J>255 THEN J=0
  681. 6245 S$(I+1)=CHR$(P):IF J=0 THEN R$(I+1)="" ELSE R$(I+1)=CHR$(J)
  682. 6250 NEXT
  683. 6255 IF CVI(G$)<>0 THEN PC$="=P"+LEFT$(L$,CVI(G$)) ELSE PC$=""
  684. 6260 CLS:LOCATE 1,1,1:PRINT"===DIALING ";N$
  685. 6265 DIAL$=RIGHT$(R$,CVI(X$))
  686. 6270 IF SERV1 THEN DIAL$=SERV1$+DIAL$
  687. 6275 IF SERV2 THEN DIAL$=SERV2$+DIAL$
  688. 6280 PRINT#1, MODM$+DIAL$:STRT$=TIME$
  689. 6285 CLOSE#2:GOSUB 2700:GOSUB 2800:GOTO 515
  690. 6300 '  -- Manual Dialing
  691. 6305 MDFLG=0:LOCATE 7,1:PRINT"Current Comm Parameters are: ";COMM$:PRINT: PRINT      "Options: 1) Use Current  2) Use Default  3) Change (1/2/3 cr=Current) ";
  692. 6306 B$=INKEY$:IF B$="" GOTO 6306 ELSE IF VAL(B$)<>1 AND VAL(B$)<>2 AND              VAL(B$)<>3 AND B$<>CHR$(13) THEN GOSUB 50500:GOTO 6306 ELSE PRINT B$
  693. 6307 IF VAL(B$)=1 OR B$=CHR$(13) THEN GOSUB 5820:MCOM$=COMM$:GOTO 6308 ELSE IF       VAL(B$)=2 THEN GOSUB 5820:MCOM$=DCOMM$:GOTO 6308 ELSE MDFLG=-1:GOSUB 5010:      MDFLG=0:MCOM$=COMM$:GOSUB 5820
  694. 6308 PRINT:PRINT"===DIAL PHONE # w/o Dial Command: (cr=Cancel) ";:QL=36:             GOSUB 2500:R$=Q$:N$="
  695. 6310 IF R$="" THEN PRINT"(cancelled)":PRINT GO$:LOCATE,,1:RETURN
  696. 6315 IF LEFT$(R$,1)="+" THEN DIAL$=SERV1$+RIGHT$(R$,LEN(R$)-1) ELSE DIAL$=R$
  697. 6320 IF LEFT$(R$,1)="-" THEN DIAL$=SERV2$+RIGHT$(R$,LEN(R$)-1)
  698. 6325 CLOSE#1:OPEN MCOM$ AS #1:PRINT#1,MODM$+DIAL$:STRT$=TIME$:PRINT:LOCATE,,1:       RETURN
  699. 6400 '  -- Revise
  700. 6405 GOSUB 6900:LOCATE 21,1,0:PRINT"Revise/add entry #:       | or...
  701. 6410 LOCATE 21,39:PRINT"Enter:  M to change modem command
  702. 6415 LOCATE 22,43:PRINT"+ / - to change long distance #s
  703. 6420 LOCATE 23,47:PRINT"C to clear directory entries
  704. 6425 LOCATE 24,47:PRINT"X to exit to dialing prompt";
  705. 6430 LOCATE 21,20,1:QL=2:GOSUB 2500:GOSUB 2555
  706. 6435 IF Q$="M" THEN 6830
  707. 6440 IF Q$="+" THEN 6835
  708. 6445 IF Q$="-" THEN 6840
  709. 6450 IF Q$="C" THEN GOSUB 6850:GOTO 6030
  710. 6455 IF Q$="X" THEN 6030
  711. 6460 IF VAL(Q$)<I1 OR VAL(Q$)>I2 THEN GOSUB 50500:LOCATE 21,20:PRINT SPACE$(LEN(Q$)):GOTO 6430
  712. 6465 DE$=Q$:GET#2,VAL(DE$)+4:Q=VAL(DE$)-I1+1
  713. 6470 '  -- Name & Number
  714. 6475 GOSUB 6900:LOCATE 22,1:PRINT"Name: ";:QL=24:GOSUB 2500:NI$=Q$
  715. 6480 IF NI$="" THEN NI$=N$
  716. 6485 LOCATE Q+4,4:PRINT NI$;SPACE$(25-LEN(NI$));:GOSUB 6910
  717. 6490 PRINT"Phone number: ";:QL=36:GOSUB 2500:RI$=Q$:XI=LEN(RI$):IF RI$="" THEN RI$=R$:XI=CVI(X$)
  718. 6495 LOCATE Q+4,30:IF XI>14 THEN PRINT RIGHT$(RI$,14) ELSE PRINT SPACE$(14-XI)+RIGHT$(RI$,XI)
  719. 6500 '  -- Comm Params
  720. 6505 GOSUB 6910:PRINT"Communications parameters ok (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555
  721. 6510 IF Q$="Y" OR Q$="" THEN BI$=B$:PI$=P$:DI$=D$:SI$=S$:GOTO 6555
  722. 6515 GOSUB 6910:PRINT"Baud rate: ";:QL=4:GOSUB 2500:BI$=Q$:IF BI$="" THEN BI$=B$
  723. 6520 LOCATE Q+4,47:PRINT SPACE$(4-LEN(BI$));BI$;
  724. 6525 GOSUB 6910:PRINT"Parity: ";:QL=1:GOSUB 2500:GOSUB 2555:PI$=Q$:IF PI$="" THEN PI$=P$
  725. 6530 LOCATE Q+4,52:PRINT PI$;
  726. 6535 GOSUB 6910:PRINT"# data bits: ";:QL=1:GOSUB 2500:DI$=Q$:IF DI$="" THEN DI$=D$
  727. 6540 LOCATE Q+4,54:PRINT DI$;
  728. 6545 GOSUB 6910:PRINT"# stop bits: ";:QL=1:GOSUB 2500:SI$=Q$:IF SI$="" THEN SI$=S$
  729. 6550 LOCATE Q+4,56:PRINT SI$;
  730. 6555 '  -- Echo & Messages
  731. 6556 GOSUB 6910:PRINT"Are the remaining parameters ok (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555
  732. 6557 IF Q$="Y" OR Q$="" THEN EI$=E$:MI$=M$:TI=CVI(T$):CI$=C$:LI$=L$:GI=CVI(G$):GOTO 6800
  733. 6560 GOSUB 6910:PRINT"Echo on (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555:EI$=Q$:IF EI$="" THEN EI$=E$:GOTO 6570
  734. 6565 IF EI$<>"Y" THEN EI$="N
  735. 6570 LOCATE Q+4,61:PRINT EI$;
  736. 6575 GOSUB 6910:PRINT"Messages on (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555:MI$=Q$:IF MI$="" THEN MI$=M$:GOTO 6585
  737. 6580 IF MI$<>"Y" THEN MI$="N
  738. 6585 LOCATE Q+4,66:PRINT MI$;
  739. 6590 '  -- Strip Characters
  740. 6595 GOSUB 6910:LOCATE 22,1:PRINT"Strip/convert characters (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555:IF Q$="" THEN TI=CVI(T$):CI$=C$:GOTO 6655
  741. 6600 IF Q$="0" OR Q$="N" THEN TI=0:CI$=STRING$(26,47):GOTO 6645
  742. 6605 IF Q$<>"Y" THEN GOSUB 50500:GOTO 6595
  743. 6610 GOSUB 6905:LOCATE 22,1:PRINT"old strip/cnvt string: ";C$
  744. 6615 LOCATE 23,1:PRINT"change this (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555:IF Q$<>"Y" THEN TI=CVI(T$):CI$=C$:LOCATE 23,1:PRINT SPACE$(20);:GOTO 6655
  745. 6620 LOCATE 24,1:PRINT"(please refer to instructions in the documentation)";:LOCATE 23,1:PRINT"new strip/cnvt string: ";:QL=24:GOSUB 2500:CI$=Q$
  746. 6625 CI$=CI$+STRING$(26-LEN(CI$),47)
  747. 6630 LOCATE 21,40:PRINT"new string ok (y/n)?";SPACE$(20);:LOCATE 21,61:QL=1:GOSUB 2500:GOSUB 2555:IF Q$="N" THEN LOCATE 23,1:PRINT SPACE$(79):GOTO 6620
  748. 6635 P=INSTR(CI$,"//"):IF P=1 THEN TI=0:GOTO 6655
  749. 6640 IF P MOD 8<>0 THEN GOSUB 50500:GOTO 6610 ELSE TI=P/8
  750. 6645 GOSUB 6905:LOCATE Q+4,71:IF TI=0 THEN PRINT "N" ELSE PRINT USING "#";TI
  751. 6650 '  -- Pacing
  752. 6655 GOSUB 6910:LOCATE 22,1:PRINT"Pacing? p=";:QL=3:GOSUB 2500:LI$=Q$:GI=LEN(LI$)
  753. 6660 IF Q$="0" OR Q$="N" OR Q$="n" THEN LI$="N":GI=0:LOCATE Q+4,75:PRINT"  N  ";:GOTO 6800
  754. 6665 IF LI$="" THEN LI$=L$:GI=CVI(G$):GOTO 6800
  755. 6670 LOCATE Q+4,75:PRINT "p="+LI$+SPACE$(3-GI)
  756. 6800 '  -- Write new info
  757. 6805 LSET N$=NI$:RSET R$=RI$:LSET X$=MKI$(XI):RSET B$=BI$:LSET P$=PI$:LSET D$=DI$:LSET S$=SI$:LSET E$=EI$:LSET M$=MI$:LSET T$=MKI$(TI):LSET C$=CI$:LSET L$=LI$:LSET G$=MKI$(GI)
  758. 6810 GOSUB 6905:LOCATE 22,1:PRINT"Is entry #";DE$;" ok (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555:Q1$=Q$
  759. 6815 IF Q1$<>"Y" AND Q1$<>"" THEN LOCATE 22,1:PRINT SPACE$(35);:GOTO 6470
  760. 6820 PUT#2,VAL(DE$)+4:GOTO 6030
  761. 6825 '  -- Modem$ & Service$
  762. 6830 GOSUB 6900:MSG$="Modem dialing command:":GOSUB 6845:PUT #2,2:GOTO 6030
  763. 6835 GOSUB 6900:MSG$="Long distance +#:":GOSUB 6845:PUT #2,3:GOTO 6030
  764. 6840 GOSUB 6900:MSG$="Long distance -#:":GOSUB 6845:PUT#2,4:GOTO 6030
  765. 6845 LOCATE 21,1:PRINT MSG$;SPACE$(79-LEN(MSG$));:LOCATE 21,LEN(MSG$)+2:QL=36:GOSUB 2500:RI$=Q$:XI=LEN(RI$):RSET R$=RI$:LSET X$=MKI$(XI):RETURN
  766. 6850 '  -- Clear Directory
  767. 6855 GOSUB 6900:LOCATE 21,1:PRINT"Clear directory from entry #:";:QL=2:GOSUB 2500:I1=VAL(Q$):IF I1<1 THEN I1=61
  768. 6860 PRINT" ... through entry #:";:QL=2:GOSUB 2500:I2=VAL(Q$):IF I2>60 THEN I2=60
  769. 6865 PRINT:PRINT"-- Are you sure (y/n)? ";:QL=1:GOSUB 2500:GOSUB 2555:IF Q$<>"Y" THEN 6030
  770. 6870 LSET N$=IFIL$:LSET R$="":LSET X$=MKI$(0):LSET B$="":LSET P$="":LSET D$="":LSET S$="":LSET E$="":LSET M$="":LSET T$=MKI$(0):LSET C$="":LSET L$="":LSET G$=MKI$(0):PUT#2,1
  771. 6875 IF MODM$="" THEN MODM$="ATDT"
  772. 6880 LSET N$="":RSET R$=MODM$:LSET X$=MKI$(LEN(MODM$)):PUT#2,2:RSET R$=SERV1$:LSET X$=MKI$(LEN(SERV1$)):PUT#2,3:RSET R$=SERV2$:LSET X$=MKI$(LEN(SERV2$)):PUT #2,4
  773. 6885 LSET N$="------------------------":RSET R$="- --- --- ----":LSET X$=MKI$(14)
  774. 6890 RSET B$="300":LSET P$="E":LSET D$="7":LSET S$="1":LSET E$="N":LSET M$="N":LSET T$=MKI$(0):LSET C$=STRING$(26,"/"):LSET L$="":LSET G$=MKI$(0)
  775. 6895 FOR I=I1 TO I2:PUT#2,I+4:NEXT:RETURN
  776. 6900 '  -- Message Area Subroutine
  777. 6905 LOCATE 21,27,0:PRINT SPACE$(52);:FOR I=22 TO 25:LOCATE I,1:PRINT SPACE$(79);:NEXT:LOCATE ,,1:RETURN
  778. 6910 LOCATE 22,1,0:PRINT SPACE$(79);:LOCATE 22,1,1:RETURN
  779. 6915 '
  780. 7000 '   *****  FUNCTION KEY DIRECTORY  *****
  781. 7005 '
  782. 7010 GOSUB 50500:IF KPG=0 THEN KPG=1
  783. 7015 LOCATE 1,39,0:PRINT CHR$(213)+STRING$(38,205)+CHR$(184)
  784. 7020 LOCATE 2,39:PRINT VL$;"     ===FUNCTION KEY DIRECTORY===     ";VL$
  785. 7025 LOCATE 3,39:PRINT VL$;SPACE$(15);:COLOR HI,BG:PRINT KPG$(KPG);:COLOR FG,BG:PRINT" F1-10";SPACE$(13);VL$
  786. 7030 LOCATE 4,39:PRINT VL$;:COLOR BG,FG:PRINT"F-   Input String";SPACE$(21);:COLOR FG,BG:PRINT VL$
  787. 7035 FOR I=1 TO 10:P=(KPG-1)*10+I
  788. 7040 LOCATE I+4,39,0:PRINT VL$;:PRINT USING "##";I;:PRINT" = ";
  789. 7045 K=LEN(K$(P)):IF K>33 THEN K=33
  790. 7050 FOR J=1 TO K:Q=ASC(MID$(K$(P),J,1)):IF Q>31 THEN PRINT CHR$(Q); ELSE IF Q=13 THEN PRINT XCR$; ELSE COLOR HI,BG:PRINT CHR$(Q+64);:COLOR FG,BG
  791. 7055 NEXT J:PRINT SPACE$(33-K)+VL$+"  ";:NEXT I
  792. 7060 LOCATE 15,39,1:PRINT CHR$(198)+STRING$(38,205)+CHR$(181)
  793. 7100 '  -- Proceed?
  794. 7105 GOSUB 7435:LOCATE 16,40,1:PRINT"Press:  R to revise ";KPG$(KPG);"-F assignments
  795. 7110 LOCATE 17,44:PRINT"F / B to page through directory
  796. 7115 LOCATE 18,48:PRINT"X to exit to terminal
  797. 7120 LOCATE 16,46,1:Q$=INPUT$(1):GOSUB 2555
  798. 7125 IF Q$="R" THEN 7200
  799. 7130 IF Q$="X" THEN CLOSE#2:GOSUB 2700:GOSUB 7435:LOCATE 16,40:PRINT GO$;:LOCATE ROW,COL:GOTO 515
  800. 7135 IF Q$="F" THEN KPG=KPG+1:IF KPG=5 THEN KPG=1:GOTO 7015 ELSE GOTO 7015
  801. 7140 IF Q$="B" THEN KPG=KPG-1:IF KPG=0 THEN KPG=4:GOTO 7015 ELSE GOTO 7015
  802. 7145 GOSUB 50500:LOCATE 21,76:PRINT SPACE$(LEN(Q$)):GOTO 7120
  803. 7200 '  -- Revise
  804. 7205 GOSUB 7435:CLOSE#2:OPEN KFIL$ AS #2:FIELD #2, 126 AS K$,2 AS L$
  805. 7210 GET#2,1:IF LEFT$(K$,LEN(IFIL$))<>IFIL$ THEN GOSUB 7425
  806. 7215 LOCATE 16,40:PRINT"Press Func. key to revise:
  807. 7220 LOCATE 18,43:PRINT"or X to exit to terminal
  808. 7225 LOCATE 16,66:Q$=INKEY$:IF Q$="" THEN 7225 ELSE IF LEN(Q$)>1 THEN 7240
  809. 7230 GOSUB 2555:IF Q$="X" THEN CLOSE#2:GOSUB 2700:GOSUB 7440:LOCATE 16,40:PRINT GO$;:LOCATE ROW,COL:GOTO 515
  810. 7235 GOSUB 50500:GOTO 7225
  811. 7240 Q=ASC(MID$(Q$,2,1))
  812. 7245 IF Q>58 AND Q<69 THEN K=(KPG-1)*10+Q-58:Q$=KPG$(KPG)+"-F"+STR$(Q-58):GOTO 7270
  813. 7250 IF Q>103 AND Q<114 THEN K=Q-93:Q$=" Alt-F"+STR$(K-10):GOTO 7270
  814. 7255 IF Q>83 AND Q<94 THEN K=Q-63:Q$="Shft-F"+STR$(K-20):GOTO 7270
  815. 7260 IF Q>93 AND Q<104 THEN K=Q-63:Q$="Ctrl-F"+STR$(K-30):GOTO 7270
  816. 7265 GOSUB 50500:GOTO 7225
  817. 7270 KY=K:GET#2,KY+1
  818. 7275 '  -- New Input String
  819. 7280 GOSUB 7450:LOCATE 16,1:PRINT"New input string for ";Q$;":":LOCATE 20,1:PRINT STRING$(80,196)
  820. 7285 LOCATE 21,1:PRINT"Use ";XCR$;" as substitute for carriage returns
  821. 7290 LOCATE 22,8:PRINT ENT$;" to leave key unchanged
  822. 7295 LOCATE 23,1:PRINT"<space>";ENT$;" to clear key
  823. 7300 LOCATE 17,1:PRINT CHR$(16);:QL=126:GOSUB 2500:KI$=Q$
  824. 7305 IF KI$="" THEN KI$=K$
  825. 7310 IF KI$=" " THEN KI$="
  826. 7315 LI=LEN(KI$)
  827. 7400 '  -- Write New Info
  828. 7405 LSET K$=KI$:LSET L$=MKI$(LI):PUT#2,KY+1
  829. 7410 IF Q$="0" THEN K$(10)=KI$:GOSUB 7455:GOTO 7015
  830. 7415 K$(KY)=KI$:GOSUB 7455:GOTO 7015
  831. 7420 '  -- Create Directory
  832. 7425 LSET K$=IFIL$:LSET L$="":PUT#2,1
  833. 7430 LSET K$="":LSET L$=MKI$(0):FOR I=2 TO 41:PUT#2,I:NEXT:RETURN
  834. 7435 '  -- Message Area Subroutine
  835. 7440 FOR I=16 TO 18:LOCATE I,39,0:PRINT VL$;SPACE$(38);VL$;"   ";:NEXT
  836. 7445 LOCATE 19,39:PRINT CHR$(212);STRING$(38,205);CHR$(190);"   ";:LOCATE ,,1:RETURN
  837. 7450 LOCATE 15,1,0:PRINT STRING$(80,205);:GOTO 7460
  838. 7455 LOCATE 15,1,0:PRINT SPACE$(80);
  839. 7460 FOR I=16 TO 23:LOCATE I,1:PRINT SPACE$(80);:NEXT:LOCATE 24,1:PRINT SPACE$(79);:LOCATE ,,1:RETURN
  840. 7465 '
  841. 8000 '   *****  REDIAL -- by Jim Gainsley, Mpls MN, March 1984  (612)338-6124
  842. 8005 '
  843. 8010 COMA=0:Q1DELAY=QDELAY 'COMA--To recognize pauses if used in DIAL$
  844. 8015 FOR I=1 TO LEN(DIAL$):IF MID$(DIAL$,I,1)="," THEN COMA=COMA+38
  845. 8020 NEXT:IX=0:CLS:V$=TIME$:LOCATE 20,4,0:PRINT"To change disconnect delay time press ";:COLOR HI,BG:PRINT"]";:COLOR FG,BG:PRINT" after '**REDIALING:' appears above.";:LOCATE 1,1
  846. 8025 MSG$="  Redialing...  *** HIT R TO RECYCLE. HIT SPACE BAR TO TERMINATE ***"     :GOSUB 2600:LOCATE 2,54:PRINT"Redial Started at: ";:COLOR HI,BG:PRINT V$;:      COLOR FG,BG:LOCATE 1,1
  847. 8030 Q1$="":Q$="":PRINT"  ===REDIALING ";N$;:LOCATE 1,45:PRINT                       "Time at Start of This Pass: ";:COLOR HI,BG:PRINT TIME$:COLOR FG,BG:            LOCATE 2,1:PRINT#1,MODM$+DIAL$:ROW=CSRLIN:COL=POS(0)
  848. 8035 SOUND SD,(12000/VAL(BAU$))+COMA:I=0:IX=IX+1:AFLG=0
  849. 8040 WHILE I<>Q1DELAY
  850. 8045  LOCATE 22,4:PRINT"THIS IS TRY #: ";IX;"  ELAPSED TIME THIS PASS ";I;
  851. 8050  B1$=INKEY$:IF B1$="R" OR B1$="r" GOTO 8115
  852. 8055  IF B1$="]" GOTO 8165
  853. 8060  '
  854. 8065  IF B1$=" " GOTO 8155
  855. 8070  IF LOC(1)>0 THEN Q$=INPUT$(LOC(1),1):Q1$=Q1$+Q$ ELSE 8080 'See Ln 9055
  856. 8075  IF INSTR(Q1$,MODM$+DIAL$)<>0 AND AFLG=0 THEN LOCATE ROW,COL:PRINT "  ** DIALING: ";MODM$+DIAL$:PRINT"  ** COM PARAMS: ";MID$(COMM$,6,10):PRINT"  ** DISCONNECT DELAY PERIOD IS: "Q1DELAY:AFLG=1:ROW=CSRLIN:COL=POS(0)
  857. 8080  I=I+1
  858. 8085  IF INSTR(Q1$,CONNECT$)<>0 GOTO 8130
  859. 8090  IF INSTR(Q1$,"BUSY")<>0 OR INSTR(Q1$,"NO CARRIER")<>0 GOTO 8125
  860. 8095  SOUND SD,18.5 'Provides elapsed time since dial completed
  861. 8100 WEND
  862. 8105 '  -- Delay Time has Expired
  863. 8110 LOCATE ROW,COL:COLOR HI,BG:PRINT"  ** DELAY PERIOD EXPIRED **";:COLOR 7,BG
  864. 8115 PRINT#1,"A":SOUND SD,30:GOSUB 8180:CLOSE#1:OPEN COMM$ AS #1:         GOTO 8025
  865. 8120 '  -- Busy or No Carrier
  866. 8125 LOCATE ROW,COL:COLOR HI,BG:PRINT"  *** LINE BUSY OR NO CARRIER ***":            COLOR FG,BG:SOUND SD,26:GOSUB 8180:GOTO 8025
  867. 8130 '  -- Connected
  868. 8135 STRT$=TIME$:MSG$=" REMOTE COMPUTER ON LINE *** HIT ANY KEY TO PROCEED ***"      :GOSUB 2600
  869. 8140 LOCATE 12,15:COLOR 31,BG:PRINT"  <<<  CONNECTED WITH "N$"  >>>":                COLOR FG,BG:LOCATE ,,1
  870. 8145 IF SILENT THEN WHILE INKEY$="":SOUND 12000,1:SOUND SD,25:WEND:CLS:GOSUB 2800:GOTO 515
  871. 8146 WHILE INKEY$="":SOUND 3560,4:SOUND 3940,4:WEND:CLS:GOSUB 2800:GOTO 515
  872. 8150 '  -- Redial Terminate
  873. 8155 PRINT#1,"A";
  874. 8160 CLS:GOSUB 50500:PRINT"===REDIAL TERMINATED...Back in Terminal Mode ===":PRINT GO$:     GOSUB 2800:GOTO 515
  875. 8165 LOCATE 13,1:INPUT"GIVE NEW DELAY IN SECONDS (10 sec. minimum  cr=default)";     Q1DELAY
  876. 8170 IF Q1DELAY=0 THEN Q1DELAY=QDELAY ELSE IF Q1DELAY<10 THEN Q1DELAY=10
  877. 8175 LOCATE 13,1:PRINT SPACE$(78);:GOTO 8070
  878. 8180 LOCATE 2,1:FOR I=1 TO 4:PRINT SPACE$(40):NEXT:LOCATE 1,1:RETURN
  879. 8199 '
  880. 8200 '   *****  ELAPSED TIME  *****
  881. 8205 '
  882. 8210 IF STRT$="--" THEN MLPSD=0:GOTO 8220
  883. 8215 MSTRT=VAL(MID$(STRT$,1,2))*60+VAL(MID$(STRT$,4,2)):MSTOP=VAL(MID$(TIME$,1,2))*60+VAL(MID$(TIME$,4,2)):MLPSD=INT(MSTOP-MSTRT):IF MSTRT>MSTOP THEN MLPSD=MLPSD+1440
  884. 8220 LOCATE 1,39:PRINT CHR$(213)+STRING$(38,205)+CHR$(184);
  885. 8225 LOCATE 2,39:PRINT VL$;"  Elapsed time this call = ";:COLOR HI,BG:PRINT MLPSD;:PRINT" min     ";:LOCATE 2,78:COLOR FG,BG:PRINT VL$;
  886. 8230 LOCATE 3,39:PRINT CHR$(192)+STRING$(38,205)+CHR$(217);
  887. 8235 LOCATE ROW,COL:GOTO 515
  888. 8240 '
  889. 8900 '   *****  ERROR SUBROUTINE  *****
  890. 8905 '
  891. 8910 GOSUB 50500:PRINT:PRINT"*** This program requires that you have a serial port."
  892. 8915 PRINT:PRINT:PRINT"(returning to DOS)":PRINT #1,"ATZ":COLOR 7,0,0:CLS:SYSTEM
  893. 8920 '
  894. 8925 COLOR HI,BG:PRINT"<<";MSG$;">>";:COLOR FG,BG:RETURN
  895. 8930 IF ERR=52 OR ERR=64 OR ERR=67 THEN MSG$="Not a valid file name.
  896. 8935 IF ERR=53 THEN MSG$="File not found.
  897. 8940 IF ERR=70 THEN MSG$="Disk is write protected.
  898. 8945 IF ERR=71 THEN MSG$="Check disk drive.
  899. 8950 IF ERR=72 THEN MSG$="Disk media error.
  900. 8955 RETURN
  901. 8960 '
  902. 9000 '   *********  E R R O R   T R A P S  **********
  903. 9001 '
  904. 9002 IF ERL=3132 AND ERR=71 THEN PRINT"DISK NOT READY!":RESUME 3145
  905. 9003 IF ERL=3132 OR ERL=3110 THEN RESUME 3135
  906. 9010 IF ERL=215 THEN RESUME 5405
  907. 9015 IF ERL=225 THEN RESUME 245
  908. 9020 IF ERL=5665 THEN RESUME 5670
  909. 9025 IF ERL=425 THEN RESUME 245
  910. 9030 IF ERR=27 THEN GOSUB 50500:MGS$="CHECK PRINTER":GOSUB 8925:PR=0:IF ERL=1610 THEN       RESUME 515 ELSE RESUME 820
  911. 9035 IF ERL=5280 THEN GOSUB 50500:GOSUB 5295:PRINT TAB(31)                                  "*** Invalid communications parameters. Try again.";:EXIT=0:RESUME 5215
  912. 9040 IF ERL=6215 AND ERR=64 THEN GOSUB 50500:LOCATE 20,1:PRINT"*** Invalid parameters for entry #";Q$:RESUME 6400
  913. 9045 IF ERL=6245 THEN GOSUB 50500:LOCATE 20,1:PRINT"*** Invalid stripping for entry #";Q$:RESUME 6400
  914. 9050 IF ERR=24 THEN MSG$="TIMEOUT":GOSUB 8925:IF PR THEN PR=0:MSG$="PRINTOUT OFF":GOSUB 8925:PR=O:CLOSE#3:RESUME 820 ELSE MSG$="CHECK MODEM":GOSUB 8925:RESUME 515
  915. 9055 IF ERR=57 THEN MSG$="":GOSUB 8925:IF RC$="X" THEN RESUME 4525 ELSE IF           TC$="X" THEN RESUME 4725 ELSE IF ERL=8070 THEN RESUME 8075 ELSE RESUME 515
  916. 9060 IF ERR=69 THEN PRINT#1,XF$;:PSE=-1:MSG$="OVERFLOW":GOSUB 8925:IF NOT PR THEN RESUME 515 ELSE MSG$="PRINTOUT OFF":PR=0:CLOSE#3:RESUME 515
  917. 9065 IF ERR=15 AND ERL=660 THEN MSG$="OVERFLOW--PRINTOUT OFF":GOSUB 8925:PR=0:CLOSE#3:RESUME 515
  918. 9070 IF ERL=3640 THEN GOSUB 50500:PRINT"*** File(s) not found. Try again.":RESUME 3645
  919. 9075 IF ERR=61 AND RC$="X" THEN GOSUB 50500:PRINT"*** DISK IS FULL":RESUME 4645
  920. 9080 IF ERR=61 THEN GOSUB 50500:PRINT:PRINT"===DISK IS FULL===":IF RC THEN RESUME 3000 ELSE RESUME 3820
  921. 9085 IF ERL=3810 THEN LOCATE 1,40:COLOR HI,BG:PRINT"***CAN'T OPEN ";DUMP$;"***";:LOCATE ROW,COL:RESUME 3820
  922. 9090 IF ERR=67 AND ERL=3595 THEN PRINT"*** Either too many files, or
  923. 9095 IF ERL=3595 THEN MSG$="":GOSUB 8930:GOSUB 50500:PRINT"*** ";MSG$;" Try again.":RESUME 3500
  924. 9100 IF ERR=67 OR ERR=70 OR ERR=71 THEN GOSUB 50500:PRINT"*** Can't read/write file in the default drive.":PRINT"Correct and hit any key to resume..":Q$=INPUT$(1):IF ERL<400 THEN RESUME 215 ELSE CLS:RESUME 400
  925. 9105 IF ERR=68 THEN GOTO 8910
  926. 9115 IF ERR=62 AND ERL=3420 THEN RESUME 3425
  927. 9120 IF ERR=53 AND ERL=11137 THEN GOSUB 50500:PRINT "===File NOT FOUND===":                 RESUME 11130
  928. 9125 IF ERR=53 AND ERL=11167 THEN GOSUB 50500:PRINT "===File NOT FOUND===":                 RESUME 11160
  929. 9900 '  -- If Not Trapped
  930. 9905 GOSUB 50500:MSG$=" Sorry, NON-RECOVERABLE ERROR "+STR$(ERR)+" at line"+ STR$(ERL):     GOSUB 2600:IF NOT ERR=5 THEN CLOSE:ON ERROR GOTO 0 ELSE ON ERROR GOTO 0
  931. 9946 '
  932. 9999 DATA 830326
  933. 10000 '
  934. 10001 '   *****  SPLIT-SCREEN OPERATION --  By Wes Meier  *****
  935. 10002 '
  936. 10003 IF SP THEN SP=0:TMP$="":LOCATE ROW,COL,1:PRINT:PRINT ELSE 10010
  937. 10004 PRINT"===Split Screen Operation Off":GOSUB 50500:PRINT:ROW=CSRLIN:COL=POS(0)
  938. 10005 LOCATE 25,1,0:PRINT CLIN$:GOSUB 2820:LOCATE ROW,COL,1:GOTO 515
  939. 10010 SP=-1:GOSUB 50500:PRINT:PRINT"===Split Screen Operation On":ROW=CSRLIN
  940. 10012 COL=POS(0):LOCATE 25,1:PRINT CLIN$:LOCATE 25,1,1:GOTO 515
  941. 10900 '
  942. 10901 ' NOTE: Lines 11000 thru 11022 changed to give multiple entries, using the        carriage return substitute, on splitscreen -Dennis Cheves-(904)376-0718
  943. 10902 '
  944. 10997 '
  945. 10998 'Line 530 modified for proper operation of backspace with both echo and splitscreen. Lines 11000 thru 11040 changed to allow the CR substitute to be used with splitscreen to provide multiple entries. --Dennis Cheves-- (904) 376-0718
  946. 10999 '
  947. 11000 IF B$=CR$ THEN RETPOS=INSTR(TMP$,XCR$):IF RETPOS=0 THEN LOCATE 25,1,0:PRINT CLIN$;:B$=TMP$:TMP$="":GOTO 11010:ELSE IF LEN(TMP$)>1 THEN GOTO 11005 ELSE TMP$="":XPOS=1:LOCATE 25,XPOS,1:GOTO 560:ELSE GOTO 11020
  948. 11005 B$=LEFT$(TMP$,RETPOS-1):TMP$=RIGHT$(TMP$,LEN(TMP$)-RETPOS):LOCATE 25,1,0: PRINT CLIN$;:XPOS=LEN(TMP$)+1:LOCATE 25,1,0:PRINT TMP$;:GOTO 11010
  949. 11010 B$=B$+CR$:GOTO 558
  950. 11020 IF B$=CHR$(27) THEN TMP$="":LOCATE 25,1,0:PRINT CLIN$;:XPOS=1 ELSE 11030
  951. 11021 LOCATE 25,XPOS,1:GOTO 560
  952. 11022 LOCATE 25,XPOS,1:GOTO 560
  953. 11030 IF B$=BS$ AND XPOS>1 THEN TMP$=LEFT$(TMP$,LEN(TMP$)-1) ELSE 11040
  954. 11032 XPOS=XPOS-1:GOSUB 2655:LOCATE 25,XPOS,1:GOTO 560
  955. 11040 IF B$=BS$ AND XPOS=1 THEN B$="":GOTO 560
  956. 11050 LOCATE 25,XPOS,1:PRINT B$;:TMP$=TMP$+B$:XPOS=XPOS+1
  957. 11055 IF XPOS>79 THEN XPOS=1
  958. 11060 GOTO 560
  959. 11097 '
  960. 11098 '   *****  CD SUBROUTINE FOR ALT-G GET A NEW DIRECTORY -- John Chapmen
  961. 11099 '
  962. 11100 GOSUB 50500:PRINT "=== SPECIFY DIRECTORY ==="
  963. 11101 GOTO 11182
  964. 11102 GOSUB 11180
  965. 11112 QL=63:PRINT "New  Directory  Name:";
  966. 11114 GOSUB 2500:PRINT:IF Q$="" THEN GOTO 11124
  967. 11116 IF LEFT$(Q$,1)<>"\" THEN PRINT "Directory Name must begin with \":              GOTO 11112
  968. 11118 NEWDIR$=DRIV$+Q$+CHR$(0):RETCD%=0 :CALL CHDIR(NEWDIR$,RETCD%)
  969. 11120 IF RETCD%=0 THEN CURDIR$=NEWDIR$:NEWDIR$="":GOSUB 11180:GOTO 515
  970. 11122 IF RETCD%=3 THEN GOSUB 50500:PRINT "PATH/DIRECTORY NOT FOUND":GOTO 11124
  971. 11123 PRINT "Invalid Return Code from CHDIR = ";RETCD%:GOTO 11124
  972. 11124 GOSUB 50500:PRINT "===CANCELLED===":GOTO 515
  973. 11127 '
  974. 11128 '   *****  ALT-I SUBROUTINE: LOAD KEYS 1-0 FROM FILE -- By John Chapmen
  975. 11129 '
  976. 11130 IF RC OR TR THEN GOSUB 50500:PRINT "ALT-1/0 KEYS CANNOT BE LOADED DURING FILE OPERATIONS": GOTO 11124
  977. 11132 GOSUB 50500:PRINT "SPECIFY FILENAME TO LOAD FROM === : "
  978. 11134 GOSUB 2500:PRINT:IF Q$="" THEN GOTO 11124
  979. 11136 ALTFILE$=Q$:CLS
  980. 11137 CLOSE #3:OPEN ALTFILE$ FOR INPUT AS #3
  981. 11138 FOR IA=1 TO 10:
  982. 11140 INPUT #3,ALTSTR$:PRINT "Alt-";IA;" = ";ALTSTR$
  983. 11142 IAX = INSTR(ALTSTR$,XCR$): IF IAX = 0 THEN 11143 ELSE MID$(ALTSTR$,IAX,1)       = CHR$(13): GOTO 11142
  984. 11143 IF LEN(ALTSTR$)>50 THEN ALT$(IA)=LEFT$(ALTSTR$,50) ELSE ALT$(IA) =ALTSTR$
  985. 11144 NEXT
  986. 11145 CLOSE #3
  987. 11146 GOSUB 50500:PRINT "Alt-1 THRU Alt-0 LOADED FROM:";ALTFILE$:GOTO 515
  988. 11157 '
  989. 11158 '   *****  ALT-U SUBROUTINE (UNLOAD Alt-1/0 TO FILEMAME) -- John Chapmen
  990. 11159 '
  991. 11160 IF RC OR TR THEN GOSUB 50500:PRINT "ALT-1/0 KEYS CANNOT BE SAVED  DURING FILE OPERATIONS": GOTO 11124
  992. 11162 GOSUB 50500:PRINT "SPECIFY FILENAME TO SAVE INTO === : "
  993. 11164 GOSUB 2500:PRINT:IF Q$="" THEN GOTO 11124
  994. 11166 ALTFILE$=Q$:CLS
  995. 11167 CLOSE #3:OPEN ALTFILE$ FOR OUTPUT AS #3
  996. 11168 FOR IA=1 TO 10:
  997. 11170 ALTSTR$ = ALT$(IA)
  998. 11172 IAX = INSTR(ALTSTR$,CR$): IF IAX = 0 THEN 11173 ELSE MID$(ALTSTR$,IAX,1)        = XCR$: GOTO 11172
  999. 11173 PRINT "Alt-";IA;" = ";ALTSTR$:
  1000. 11175 PRINT #3,CHR$(34);ALTSTR$;CHR$(34)
  1001. 11176 NEXT
  1002. 11177 CLOSE #3
  1003. 11178 GOSUB 50500:PRINT "Alt-1 THRU Alt-0 SAVED INTO:";ALTFILE$:GOTO 515
  1004. 11179 '  -- Service Subroutines for SUBDIRECTORY SUPPORT -- John Chapmen
  1005. 11180 IF CURDIR$<>"" THEN PRINT:PRINT"Current Directory is: [";DRIV$;"]";             MID$(CURDIR$,INSTR(CURDIR$,"\"))
  1006. 11181 RETURN
  1007. 11182 CURDIR$="":NEWDIR$="                                "
  1008. 11183 NEWDIR$=   NEWDIR$+"                                "+CHR$(0)
  1009. 11184 '     If driv$="" or driv$=" " then driv$="@"
  1010. 11185 CALL GETDIR(NEWDIR$,DRIV$,RETCD%)
  1011. 11186 IF RETCD%<>0 THEN PRINT "Return Code from GETDIR = ";RETCD%
  1012. 11187 GOSUB 40000:GOTO 11102
  1013. 12000 '************* ESC CONTROL **************
  1014. 12010 CLEN=LEN(C$)
  1015. 12020 CEND$=MID$(C$,CLEN,1)
  1016. 12025 IF CLEN<>2 THEN 12030
  1017. 12027 IF ASC(CEND$)<>91 THEN RETURN 'INVALID ESC SEQ
  1018. 12030 ON FF GOTO 12300,12070,12070,12400,12500,12600,12700
  1019. 12050 RETURN
  1020. 12060 '************* COLOR CONTROL ************
  1021. 12070 FOR J=1 TO INT(CLEN/3):Z = VAL(MID$(C$,(3*J),2))
  1022. 12080 IF Z = 30 THEN FG = 0: GOTO 12290 'BLACK
  1023. 12090 IF Z = 31 THEN FG = 4: GOTO 12290 'RED
  1024. 12100 IF Z = 32 THEN FG = 2: GOTO 12290 'GREEN
  1025. 12110 IF Z = 33 THEN FG = 6: GOTO 12290 'BROWN
  1026. 12120 IF Z = 34 THEN FG = 1: GOTO 12290 'BLUE
  1027. 12130 IF Z = 35 THEN FG = 5: GOTO 12290 'MAGENTA
  1028. 12140 IF Z = 36 THEN FG = 3: GOTO 12290 'CYAN
  1029. 12150 IF Z = 37 THEN FG = 7: GOTO 12290 'WHITE
  1030. 12160 IF Z = 40 THEN BG = 0: GOTO 12290 'BLACK
  1031. 12170 IF Z = 41 THEN BG = 4: GOTO 12290 'RED
  1032. 12180 IF Z = 42 THEN BG = 2: GOTO 12290 'GREEN
  1033. 12190 IF Z = 43 THEN BG = 6: GOTO 12290 'BROWN
  1034. 12200 IF Z = 44 THEN BG = 1: GOTO 12290 'BLUE
  1035. 12210 IF Z = 45 THEN BG = 5: GOTO 12290 'MAGENTA
  1036. 12220 IF Z = 46 THEN BG = 3: GOTO 12290 'CYAN
  1037. 12230 IF Z = 47 THEN BG = 7: GOTO 12290 'WHITE
  1038. 12240 IF Z = 0  THEN BG = BGI: FG = FGI:IFLAG = 0:BFLAG=0: GOTO 12290
  1039. 12250 IF Z = 2  THEN CLS   : LOCATE 1,1:GOTO 12290 'CLEAR
  1040. 12260 IF Z = 1  THEN IFLAG = 8:GOTO 12290 'INTENSITY HIGH
  1041. 12270 IF Z = 5  THEN BFLAG = 16:GOTO 12290 'BLINK
  1042. 12280 '
  1043. 12290 NEXT J:FFG=FG+IFLAG+BFLAG:COLOR FFG,BG:RETURN
  1044. 12300 '*********** CURSOR POSITION ************
  1045. 12310 '
  1046. 12320 PROW=VAL(MID$(C$,CLEN-5,2))
  1047. 12330 PCOL=VAL(MID$(C$,CLEN-2,2))
  1048. 12340 LOCATE PROW,PCOL
  1049. 12350 RETURN
  1050. 12400 '***********  MUSIC  CONTROL ************
  1051. 12410 '
  1052. 12420 PLAY MID$(C$,3,(CLEN-3))
  1053. 12430 RETURN
  1054. 12500 '*********** SCREEN  CONTROL ************
  1055. 12510 '
  1056. 12520 MODE=VAL(MID$(C$,CLEN-11,2))
  1057. 12530 BURST=VAL(MID$(C$,CLEN-8,2))
  1058. 12540 APAGE=VAL(MID$(C$,CLEN-5,2))
  1059. 12550 VPAGE=VAL(MID$(C$,CLEN-2,2))
  1060. 12560 SCREEN MODE,BURST,APAGE,VPAGE
  1061. 12570 RETURN
  1062. 12600 '*********** STRING   INPUT  ************
  1063. 12610 '
  1064. 12620 INPUT I$:PRINT #1,I$
  1065. 12630 RETURN
  1066. 12700 '****** ESCAPE SEQUENCE VERIFY ******
  1067. 12710 '
  1068. 12720 RETURN 655
  1069. 13000 IF IB THEN IB=0:PRINT"===I.B.M. 3101 Operation Off":GOSUB 50500:GOTO 515
  1070. 13005 IB=-1:GOSUB 50500:PRINT"===I.B.M. 3101 Operation On":GOTO 515
  1071. 13010 FOR I = 1 TO LEN(A$):C$=MID$(A$,I,1)
  1072. 13015 ON ESCSEQ GOTO 13115,13140,13150
  1073. 13020 IF C$<" " THEN 13060
  1074. 13025 IF COL=80 AND ROW=24 THEN GOTO 13035
  1075. 13030 PRINT C$;
  1076. 13035 COL=COL+1:IF COL>80 THEN COL=1:ROW=ROW+1:IF ROW>24 THEN ROW=24
  1077. 13040 GOTO 13380
  1078. 13045 '
  1079. 13050 ' 3101 Control character encountered
  1080. 13055 '
  1081. 13060 C=ASC(C$)
  1082. 13065 IF C=13 THEN COL=1:GOTO 13375
  1083. 13070 IF C=10 AND ROW<24 THEN ROW=ROW+1:GOTO 13375
  1084. 13075 IF C=7 THEN GOSUB 50500:GOTO 13380
  1085. 13080 IF C=8  AND COL>1 THEN COL=COL-1:GOTO 13375
  1086. 13085 IF C=12 THEN ROW=1:COL=1:CLS:GOTO 13375
  1087. 13090 IF C<>27 THEN 13380
  1088. 13095 '
  1089. 13100 ' ESC sequence; read next character and come back
  1090. 13105 '
  1091. 13110 ESCSEQ=1:GOTO 13380
  1092. 13115 ESCSEQ=0:IF C$<>"Y" THEN 13175
  1093. 13120 '
  1094. 13125 ' Repositioning cursor; now get row and column bytes
  1095. 13130 '
  1096. 13135 ESCSEQ=2:GOTO 13380
  1097. 13140 ROW=ASC(C$)-31:IF ROW<1 OR ROW>24 THEN ROW=1
  1098. 13145 ESCSEQ=3:GOTO 13380
  1099. 13150 COL=ASC(C$)-31:IF COL<1 OR COL>80 THEN COL=1
  1100. 13155 ESCSEQ=0:GOTO 13375
  1101. 13160 '
  1102. 13165 ' Handle cursor up
  1103. 13170 '
  1104. 13175 IF C$<>"A" THEN 13205
  1105. 13180 IF ROW >1 THEN ROW=ROW-1
  1106. 13185 GOTO 13375
  1107. 13190 '
  1108. 13195 ' Handle cursor down
  1109. 13200 '
  1110. 13205 IF C$<>"B" THEN 13240
  1111. 13210 IF ROW <24 THEN ROW=ROW+1
  1112. 13215 GOTO 13375
  1113. 13220 '
  1114. 13225 ' Handle cursor right
  1115. 13230 '
  1116. 13235 '
  1117. 13240 IF C$<>"C" THEN 13270
  1118. 13245 COL=COL+1:IF COL >80 THEN COL=1:IF ROW > 23 THEN ROW=24 ELSE ROW=ROW+1
  1119. 13250 GOTO 13375
  1120. 13255 '
  1121. 13260 ' Handle cursor left
  1122. 13265 '
  1123. 13270 IF C$<>"D" THEN 13300
  1124. 13275 COL=COL-1:IF COL <1 THEN COL=80:IF ROW > 1 THEN ROW=ROW-1 ELSE ROW=1
  1125. 13280 GOTO 13375
  1126. 13285 '
  1127. 13290 ' Handle erase to end of page
  1128. 13295 '
  1129. 13300 IF C$<>"J" THEN 13335
  1130. 13305 IF ROW<24 THEN PRINT SPACE$(81-COL);
  1131. 13310 IF ROW<23 THEN FOR TROW=ROW+1 TO 23:PRINT SPACE$(80);:NEXT TROW
  1132. 13315 IF ROW<24 THEN PRINT SPACE$(79); ELSE PRINT SPACE$(80-COL);
  1133. 13320 '
  1134. 13325 ' Clear the screen
  1135. 13330 '
  1136. 13335 IF C$<>"L" THEN 13360
  1137. 13340 ROW=1:COL=1:CLS:GOTO 13375
  1138. 13345 '
  1139. 13350 ' Goto Home address
  1140. 13355 '
  1141. 13360 IF C$<>"H" THEN 13380
  1142. 13365 ROW=1:COL=1
  1143. 13370 '
  1144. 13375 LOCATE ROW,COL,1
  1145. 13380 NEXT
  1146. 13385 GOTO 515
  1147. 40000 ' reset parity and number of data bits on the fly ******************
  1148. 40100 IF PAR$="N" AND DTA$="7" THEN NEWPD=2
  1149. 40200 IF PAR$="E" AND DTA$="7" THEN NEWPD=26
  1150. 40300 IF PAR$="O" AND DTA$="7" THEN NEWPD=10
  1151. 40400 IF PAR$="M" AND DTA$="7" THEN NEWPD=42
  1152. 40500 IF DTA$="8" THEN NEWPD=3
  1153. 40600 OUT LCR,NEWPD
  1154. 40700 RETURN
  1155. 50000 '
  1156. 50001 '   *****  Silent Mode (lines 50000-60020)   --  Bob Mahoney  *****
  1157. 50002 '
  1158. 50003 'handle squeals SFRE=XX:SLEN=YY:GOSUB 50000 - This code inserts proper time delay even if silence is desired.
  1159. 50010 IF SILENT THEN SOUND SD,SLEN:RETURN
  1160. 50020 SOUND SFRE,SLEN:RETURN
  1161. 50500 'handle the standard BEEP
  1162. 50510 IF SILENT THEN RETURN:ELSE BEEP:RETURN
  1163. 60000 'toggle silent mode
  1164. 60010 IF SILENT THEN SILENT=0:PRINT"===Silent Operation Off":BEEP:GOTO 515
  1165. 60020 SILENT=-1:PRINT"===Silent Operation On":GOTO 515
  1166.